chemoelectric

UTF-8 encoding and decoding, VERIFIED

Nov 20th, 2025
502
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 57.55 KB | Source Code | 0 0
  1. (*
  2.  
  3. UTF-8 encoding and decoding in ATS2.
  4.  
  5. This is adapted from library code I wrote long ago and actually
  6. handles the original 1-to-6-byte encoding, as well. Valid Unicode
  7. requires only 1 to 4 bytes.
  8.  
  9. What is remarkable about the following rather lengthy code is its
  10. use of proofs of what is and what is not valid UTF-8. Much of what
  11. follows is proofs rather than executable code. It seemed simpler to
  12. "mostly copy" my old code, than to try to pare that code down to a
  13. minimum that still demonstrated some of what makes ATS different
  14. from all but a few (if any) other languages.
  15.  
  16. *)
  17.  
  18. #define ATS_EXTERN_PREFIX "utf8_encoding_"
  19.  
  20. #include "share/atspre_define.hats"
  21. #include "share/atspre_staload.hats"
  22.  
  23. (* A variant of ‘andalso’, with dependent types. *)
  24. fn {}
  25. andalso1 {b1, b2 : bool} (b1 : bool b1, b2 : bool b2) :<>
  26. [b3 : bool | b3 == (b1 && b2)] bool b3 =
  27. if b1 then
  28. b2
  29. else
  30. false
  31.  
  32. infixl (&&) &&&
  33. macdef &&& = andalso1
  34.  
  35. (*###################### C CODE ####################################*)
  36.  
  37. %{^
  38.  
  39. _Static_assert (4 <= sizeof (int),
  40. "sizeof(int) must equal at least 4");
  41.  
  42. #define utf8_encoding_2_entries(v) \
  43. (v), (v)
  44.  
  45. #define utf8_encoding_4_entries(v) \
  46. utf8_encoding_2_entries (v), \
  47. utf8_encoding_2_entries (v)
  48.  
  49. #define utf8_encoding_8_entries(v) \
  50. utf8_encoding_4_entries (v), \
  51. utf8_encoding_4_entries (v)
  52.  
  53. #define utf8_encoding_16_entries(v) \
  54. utf8_encoding_8_entries (v), \
  55. utf8_encoding_8_entries (v)
  56.  
  57. #define utf8_encoding_32_entries(v) \
  58. utf8_encoding_16_entries (v), \
  59. utf8_encoding_16_entries (v)
  60.  
  61. #define utf8_encoding_64_entries(v) \
  62. utf8_encoding_32_entries (v), \
  63. utf8_encoding_32_entries (v)
  64.  
  65. #define utf8_encoding_128_entries(v) \
  66. utf8_encoding_64_entries (v), \
  67. utf8_encoding_64_entries (v)
  68.  
  69. static const atstype_int8 utf8_encoding_extended_utf8_lengths__[256] = {
  70. utf8_encoding_128_entries (1),
  71. utf8_encoding_64_entries (-1),
  72. utf8_encoding_32_entries (2),
  73. utf8_encoding_16_entries (3),
  74. utf8_encoding_8_entries (4),
  75. utf8_encoding_4_entries (5),
  76. utf8_encoding_2_entries (6),
  77. utf8_encoding_2_entries (-1)
  78. };
  79.  
  80. static const atstype_int8 utf8_encoding_utf8_lengths__[256] = {
  81. utf8_encoding_128_entries (1),
  82. utf8_encoding_64_entries (-1),
  83. utf8_encoding_32_entries (2),
  84. utf8_encoding_16_entries (3),
  85. utf8_encoding_8_entries (4),
  86. utf8_encoding_4_entries (-1),
  87. utf8_encoding_2_entries (-1),
  88. utf8_encoding_2_entries (-1)
  89. };
  90.  
  91. #define utf8_encoding_extended_utf8_character_length(c) \
  92. (utf8_encoding_extended_utf8_lengths__[(atstype_uint8) (c)])
  93.  
  94. #define utf8_encoding_utf8_character_length(c) \
  95. (utf8_encoding_utf8_lengths__[(atstype_uint8) (c)])
  96.  
  97. %}
  98.  
  99. (*###################### INTERFACE #################################*)
  100.  
  101. stadef
  102. is_valid_unicode_code_point (u : int) : bool =
  103. (0x0 <= u && u < 0xD800) || (0xE000 <= u && u <= 0x10FFFF)
  104.  
  105. extern fun {}
  106. is_valid_unicode_code_point :
  107. {u : int} int u -<>
  108. [b : bool | b == is_valid_unicode_code_point u]
  109. bool b
  110.  
  111. (*------------------------------------------------------------------*)
  112.  
  113. stadef
  114. is_extended_utf8_1byte_first_byte (c0 : int) : bool =
  115. 0x00 <= c0 && c0 <= 0x7F
  116.  
  117. stadef
  118. is_extended_utf8_2byte_first_byte (c0 : int) : bool =
  119. 0xC0 <= c0 && c0 <= 0xDF
  120.  
  121. stadef
  122. is_extended_utf8_3byte_first_byte (c0 : int) : bool =
  123. 0xE0 <= c0 && c0 <= 0xEF
  124.  
  125. stadef
  126. is_extended_utf8_4byte_first_byte (c0 : int) : bool =
  127. 0xF0 <= c0 && c0 <= 0xF7
  128.  
  129. stadef
  130. is_extended_utf8_5byte_first_byte (c0 : int) : bool =
  131. 0xF8 <= c0 && c0 <= 0xFB
  132.  
  133. stadef
  134. is_extended_utf8_6byte_first_byte (c0 : int) : bool =
  135. 0xFC <= c0 && c0 <= 0xFD
  136.  
  137. stadef
  138. extended_utf8_character_length (c0 : int) : int =
  139. ifint (is_extended_utf8_1byte_first_byte c0, 1,
  140. ifint (is_extended_utf8_2byte_first_byte c0, 2,
  141. ifint (is_extended_utf8_3byte_first_byte c0, 3,
  142. ifint (is_extended_utf8_4byte_first_byte c0, 4,
  143. ifint (is_extended_utf8_5byte_first_byte c0, 5,
  144. ifint (is_extended_utf8_6byte_first_byte c0, 6, ~1))))))
  145.  
  146. stadef
  147. extended_utf8_char_length_relation (c0 : int, n : int) : bool =
  148. (n == 1 && is_extended_utf8_1byte_first_byte c0) ||
  149. (n == 2 && is_extended_utf8_2byte_first_byte c0) ||
  150. (n == 3 && is_extended_utf8_3byte_first_byte c0) ||
  151. (n == 4 && is_extended_utf8_4byte_first_byte c0) ||
  152. (n == 5 && is_extended_utf8_5byte_first_byte c0) ||
  153. (n == 6 && is_extended_utf8_6byte_first_byte c0)
  154.  
  155. extern prfun
  156. extended_utf8_char_length_relation_to_length :
  157. {c0 : int}
  158. {n : int | extended_utf8_char_length_relation (c0, n) ||
  159. (n == ~1 && ((c0 < 0x00) ||
  160. (0x7F < c0 && c0 < 0xC0) ||
  161. (0xFD < c0)))}
  162. () -<prf> [n == extended_utf8_character_length c0] void
  163.  
  164. extern prfun
  165. extended_utf8_char_length_to_length_relation :
  166. {c0 : int}
  167. {n : int | n == extended_utf8_character_length c0}
  168. () -<prf>
  169. [extended_utf8_char_length_relation (c0, n) ||
  170. (n == ~1 && ((c0 < 0x00) || (0x7F < c0 && c0 < 0xC0) || (0xFD < c0)))]
  171. void
  172.  
  173. // extended_utf8_character_length:
  174. //
  175. // Return value = 1, 2, 3, or 4 indicates that there may be a valid
  176. // UTF-8 character, of the given length. It may also be a `valid'
  177. // overlong sequence. Otherwise there definitely is not a valid
  178. // character of any sort starting with the given byte. Return
  179. // value = 5 or 6 indicates the possible start of an `extended
  180. // UTF-8' character of the given length, including code points up
  181. // to 0xffffffff. Return value = ~1 means the byte is not the
  182. // start of a valid sequence.
  183. extern fun
  184. extended_utf8_character_length :
  185. {c0 : int | 0x00 <= c0; c0 <= 0xFF} int c0 -<>
  186. [n : int | n == extended_utf8_character_length c0] int n = "mac#%"
  187.  
  188. stadef
  189. utf8_character_length (c0 : int) : int =
  190. ifint (is_extended_utf8_1byte_first_byte c0, 1,
  191. ifint (is_extended_utf8_2byte_first_byte c0, 2,
  192. ifint (is_extended_utf8_3byte_first_byte c0, 3,
  193. ifint (is_extended_utf8_4byte_first_byte c0, 4, ~1))))
  194.  
  195. stadef
  196. utf8_char_length_relation (c0 : int, n : int) : bool =
  197. (n == 1 && is_extended_utf8_1byte_first_byte c0) ||
  198. (n == 2 && is_extended_utf8_2byte_first_byte c0) ||
  199. (n == 3 && is_extended_utf8_3byte_first_byte c0) ||
  200. (n == 4 && is_extended_utf8_4byte_first_byte c0)
  201.  
  202. extern prfun
  203. utf8_char_length_relation_to_length :
  204. {c0 : int}
  205. {n : int | utf8_char_length_relation (c0, n) ||
  206. (n == ~1 && ((c0 < 0x00) ||
  207. (0x7F < c0 && c0 < 0xC0) ||
  208. (0xF7 < c0)))}
  209. () -<prf> [n == utf8_character_length c0] void
  210.  
  211. extern prfun
  212. utf8_char_length_to_length_relation :
  213. {c0 : int}
  214. {n : int | n == utf8_character_length c0}
  215. () -<prf>
  216. [utf8_char_length_relation (c0, n) ||
  217. (n == ~1 && ((c0 < 0x00) || (0x7F < c0 && c0 < 0xC0) || (0xF7 < c0)))]
  218. void
  219.  
  220. extern fun
  221. utf8_character_length :
  222. {c0 : int | 0x00 <= c0; c0 <= 0xFF} int c0 -<>
  223. [n : int | n == utf8_character_length c0] int n = "mac#%"
  224.  
  225. (*------------------------------------------------------------------*)
  226.  
  227. stadef
  228. is_valid_utf8_continuation_byte (c : int) : bool =
  229. 0x80 <= c && c <= 0xBF
  230.  
  231. stadef
  232. is_invalid_utf8_continuation_byte (c : int) : bool =
  233. c < 0x80 || 0xBF < c
  234.  
  235. extern fun {}
  236. is_valid_utf8_continuation_byte :
  237. {c : int} int c -<>
  238. [b : bool | b == is_valid_utf8_continuation_byte c] bool b
  239.  
  240. (*------------------------------------------------------------------*)
  241.  
  242. stadef
  243. extended_utf8_char_1byte_decoding (c0 : int) : int =
  244. c0
  245.  
  246. stadef
  247. extended_utf8_char_2byte_decoding (c0 : int, c1 : int) : int =
  248. 64 * (c0 - 0xC0) + (c1 - 0x80)
  249.  
  250. stadef
  251. extended_utf8_char_3byte_decoding (c0 : int, c1 : int, c2 : int) : int =
  252. 64 * 64 * (c0 - 0xE0) + 64 * (c1 - 0x80) + (c2 - 0x80)
  253.  
  254. stadef
  255. extended_utf8_char_4byte_decoding (c0 : int, c1 : int, c2 : int,
  256. c3 : int) : int =
  257. 64 * 64 * 64 * (c0 - 0xF0) + 64 * 64 * (c1 - 0x80) +
  258. 64 * (c2 - 0x80) + (c3 - 0x80)
  259.  
  260. stadef
  261. extended_utf8_char_5byte_decoding (c0 : int, c1 : int, c2 : int,
  262. c3 : int, c4 : int) : int =
  263. 64 * 64 * 64 * 64 * (c0 - 0xF8) + 64 * 64 * 64 * (c1 - 0x80) +
  264. 64 * 64 * (c2 - 0x80) + 64 * (c3 - 0x80) + (c4 - 0x80)
  265.  
  266. stadef
  267. extended_utf8_char_6byte_decoding (c0 : int, c1 : int, c2 : int,
  268. c3 : int, c4 : int, c5 : int) : int =
  269. 64 * 64 * 64 * 64 * 64 * (c0 - 0xFC) + 64 * 64 * 64 * 64 * (c1 - 0x80) +
  270. 64 * 64 * 64 * (c2 - 0x80) + 64 * 64 * (c3 - 0x80) +
  271. 64 * (c4 - 0x80) + (c5 - 0x80)
  272.  
  273. dataprop EXTENDED_UTF8_CHAR (length : int, u : int, c0 : int, c1 : int,
  274. c2 : int, c3 : int, c4 : int, c5 : int) =
  275. | {u, c0 : int |
  276. 0 <= u; u <= 0x7F;
  277. is_extended_utf8_1byte_first_byte c0;
  278. u == extended_utf8_char_1byte_decoding (c0)}
  279. EXTENDED_UTF8_CHAR_1byte (1, u, c0, ~1, ~1, ~1, ~1, ~1)
  280. //
  281. | {u, c0, c1 : int |
  282. 0 <= u; u <= 0x7FF;
  283. is_extended_utf8_2byte_first_byte c0;
  284. is_valid_utf8_continuation_byte c1;
  285. u == extended_utf8_char_2byte_decoding (c0, c1)}
  286. EXTENDED_UTF8_CHAR_2byte (2, u, c0, c1, ~1, ~1, ~1, ~1)
  287. //
  288. | {u, c0, c1, c2 : int |
  289. 0 <= u; u <= 0xFFFF;
  290. is_extended_utf8_3byte_first_byte c0;
  291. is_valid_utf8_continuation_byte c1;
  292. is_valid_utf8_continuation_byte c2;
  293. u == extended_utf8_char_3byte_decoding (c0, c1, c2)}
  294. EXTENDED_UTF8_CHAR_3byte (3, u, c0, c1, c2, ~1, ~1, ~1)
  295. //
  296. | {u, c0, c1, c2, c3 : int |
  297. 0 <= u; u <= 0x1FFFFF;
  298. is_extended_utf8_4byte_first_byte c0;
  299. is_valid_utf8_continuation_byte c1;
  300. is_valid_utf8_continuation_byte c2;
  301. is_valid_utf8_continuation_byte c3;
  302. u == extended_utf8_char_4byte_decoding (c0, c1, c2, c3)}
  303. EXTENDED_UTF8_CHAR_4byte (4, u, c0, c1, c2, c3, ~1, ~1)
  304. //
  305. | {u, c0, c1, c2, c3, c4 : int |
  306. 0 <= u; u <= 0x3FFFFFF;
  307. is_extended_utf8_5byte_first_byte c0;
  308. is_valid_utf8_continuation_byte c1;
  309. is_valid_utf8_continuation_byte c2;
  310. is_valid_utf8_continuation_byte c3;
  311. is_valid_utf8_continuation_byte c4;
  312. u == extended_utf8_char_5byte_decoding (c0, c1, c2, c3, c4)}
  313. EXTENDED_UTF8_CHAR_5byte (5, u, c0, c1, c2, c3, c4, ~1)
  314. //
  315. | {u, c0, c1, c2, c3, c4, c5 : int |
  316. 0 <= u; u <= 0x7FFFFFFF;
  317. is_extended_utf8_6byte_first_byte c0;
  318. is_valid_utf8_continuation_byte c1;
  319. is_valid_utf8_continuation_byte c2;
  320. is_valid_utf8_continuation_byte c3;
  321. is_valid_utf8_continuation_byte c4;
  322. is_valid_utf8_continuation_byte c5;
  323. u == extended_utf8_char_6byte_decoding (c0, c1, c2, c3, c4, c5)}
  324. EXTENDED_UTF8_CHAR_6byte (6, u, c0, c1, c2, c3, c4, c5)
  325.  
  326. extern prfun
  327. decode_extended_utf8_istot :
  328. {n : int | 1 <= n; n <= 6}
  329. {c0, c1, c2, c3, c4, c5 : int |
  330. extended_utf8_char_length_relation (c0, n);
  331. n <= 1 || is_valid_utf8_continuation_byte c1;
  332. n <= 2 || is_valid_utf8_continuation_byte c2;
  333. n <= 3 || is_valid_utf8_continuation_byte c3;
  334. n <= 4 || is_valid_utf8_continuation_byte c4;
  335. n <= 5 || is_valid_utf8_continuation_byte c5;
  336. 1 < n || c1 == ~1;
  337. 2 < n || c2 == ~1;
  338. 3 < n || c3 == ~1;
  339. 4 < n || c4 == ~1;
  340. 5 < n || c5 == ~1}
  341. () -<prf> [u : int] EXTENDED_UTF8_CHAR (n, u, c0, c1, c2, c3, c4, c5)
  342.  
  343. extern prfun
  344. decode_extended_utf8_isfun :
  345. {na : int | 1 <= na; na <= 6}
  346. {ua : int}
  347. {c0a, c1a, c2a, c3a, c4a, c5a : int}
  348. {nb : int | nb == na}
  349. {ub : int}
  350. {c0b, c1b, c2b, c3b, c4b, c5b : int |
  351. c0b == c0a;
  352. c1b == c1a;
  353. c2b == c2a;
  354. c3b == c3a;
  355. c4b == c4a;
  356. c5b == c5a}
  357. (EXTENDED_UTF8_CHAR (na, ua, c0a, c1a, c2a, c3a, c4a, c5a),
  358. EXTENDED_UTF8_CHAR (nb, ub, c0b, c1b, c2b, c3b, c4b, c5b)) -<prf>
  359. [ua == ub] void
  360.  
  361. extern prfun
  362. lemma_extended_utf8_char_length :
  363. {n : int} {u : int} {c0, c1, c2, c3, c4, c5 : int}
  364. EXTENDED_UTF8_CHAR (n, u, c0, c1, c2, c3, c4, c5) -<prf>
  365. [n == extended_utf8_character_length c0] void
  366.  
  367. extern fun {}
  368. decode_extended_utf8_1byte :
  369. {c0 : int | 0x00 <= c0; c0 <= 0x7F} int c0 -<>
  370. [u : int] (EXTENDED_UTF8_CHAR (1, u, c0, ~1, ~1, ~1, ~1, ~1) | int u)
  371.  
  372. extern fun {}
  373. decode_extended_utf8_2byte :
  374. {c0, c1 : int | 0xC0 <= c0; c0 <= 0xDF;
  375. is_valid_utf8_continuation_byte c1}
  376. (int c0, int c1) -<>
  377. [u : int] (EXTENDED_UTF8_CHAR (2, u, c0, c1, ~1, ~1, ~1, ~1) | int u)
  378.  
  379. extern fun {}
  380. decode_extended_utf8_3byte :
  381. {c0, c1, c2 : int | 0xE0 <= c0; c0 <= 0xEF;
  382. is_valid_utf8_continuation_byte c1;
  383. is_valid_utf8_continuation_byte c2}
  384. (int c0, int c1, int c2) -<>
  385. [u : int] (EXTENDED_UTF8_CHAR (3, u, c0, c1, c2, ~1, ~1, ~1) | int u)
  386.  
  387. extern fun {}
  388. decode_extended_utf8_4byte :
  389. {c0, c1, c2, c3 : int | 0xF0 <= c0; c0 <= 0xF7;
  390. is_valid_utf8_continuation_byte c1;
  391. is_valid_utf8_continuation_byte c2;
  392. is_valid_utf8_continuation_byte c3}
  393. (int c0, int c1, int c2, int c3) -<>
  394. [u : int] (EXTENDED_UTF8_CHAR (4, u, c0, c1, c2, c3, ~1, ~1) | int u)
  395.  
  396. extern fun {}
  397. decode_extended_utf8_5byte :
  398. {c0, c1, c2, c3, c4 : int | 0xF8 <= c0; c0 <= 0xFB;
  399. is_valid_utf8_continuation_byte c1;
  400. is_valid_utf8_continuation_byte c2;
  401. is_valid_utf8_continuation_byte c3;
  402. is_valid_utf8_continuation_byte c4}
  403. (int c0, int c1, int c2, int c3, int c4) -<>
  404. [u : int] (EXTENDED_UTF8_CHAR (5, u, c0, c1, c2, c3, c4, ~1) | int u)
  405.  
  406. extern fun {}
  407. decode_extended_utf8_6byte :
  408. {c0, c1, c2, c3, c4, c5 : int | 0xFC <= c0; c0 <= 0xFD;
  409. is_valid_utf8_continuation_byte c1;
  410. is_valid_utf8_continuation_byte c2;
  411. is_valid_utf8_continuation_byte c3;
  412. is_valid_utf8_continuation_byte c4;
  413. is_valid_utf8_continuation_byte c5}
  414. (int c0, int c1, int c2, int c3, int c4, int c5) -<>
  415. [u : int]
  416. (EXTENDED_UTF8_CHAR (6, u, c0, c1, c2, c3, c4, c5) | int u)
  417.  
  418. (*------------------------------------------------------------------*)
  419.  
  420. stadef extended_utf8_shortest_length (u : int) =
  421. ifint (u < 0, ~1,
  422. ifint (u <= 0x7F, 1,
  423. ifint (u <= 0x7FF, 2,
  424. ifint (u <= 0xFFFF, 3,
  425. ifint (u <= 0x1FFFFF, 4,
  426. ifint (u <= 0x3FFFFFF, 5,
  427. ifint (u <= 0x7FFFFFFF, 6, ~1)))))))
  428.  
  429. dataprop EXTENDED_UTF8_SHORTEST (length : int, u : int, c0 : int, c1 : int,
  430. c2 : int, c3 : int, c4 : int, c5 : int) =
  431. | {u, c0 : int |
  432. 0 <= u; u <= 0x7F;
  433. c0 == u}
  434. EXTENDED_UTF8_SHORTEST_1byte (1, u, c0, ~1, ~1, ~1, ~1, ~1) of
  435. EXTENDED_UTF8_CHAR (1, u, c0, ~1, ~1, ~1, ~1, ~1)
  436. //
  437. | {u, c0, c1 : int |
  438. 0x7F < u; u <= 0x7FF;
  439. c0 == 0xC0 + (u \ndiv 64);
  440. c1 == 0x80 + (u \nmod 64)}
  441. EXTENDED_UTF8_SHORTEST_2byte (2, u, c0, c1, ~1, ~1, ~1, ~1) of
  442. EXTENDED_UTF8_CHAR (2, u, c0, c1, ~1, ~1, ~1, ~1)
  443. //
  444. | {u, c0, c1, c2 : int |
  445. 0x7FF < u; u <= 0xFFFF;
  446. c0 == 0xE0 + (u \ndiv (64 * 64));
  447. c1 == 0x80 + ((u \ndiv 64) \nmod 64);
  448. c2 == 0x80 + (u \nmod 64)}
  449. EXTENDED_UTF8_SHORTEST_3byte (3, u, c0, c1, c2, ~1, ~1, ~1) of
  450. EXTENDED_UTF8_CHAR (3, u, c0, c1, c2, ~1, ~1, ~1)
  451. //
  452. | {u, c0, c1, c2, c3 : int |
  453. 0xFFFF < u; u <= 0x1FFFFF;
  454. c0 == 0xF0 + (u \ndiv (64 * 64 * 64));
  455. c1 == 0x80 + ((u \ndiv (64 * 64)) \nmod 64);
  456. c2 == 0x80 + ((u \ndiv 64) \nmod 64);
  457. c3 == 0x80 + (u \nmod 64)}
  458. EXTENDED_UTF8_SHORTEST_4byte (4, u, c0, c1, c2, c3, ~1, ~1) of
  459. EXTENDED_UTF8_CHAR (4, u, c0, c1, c2, c3, ~1, ~1)
  460. //
  461. | {u, c0, c1, c2, c3, c4 : int |
  462. 0x1FFFFF < u; u <= 0x3FFFFFF;
  463. c0 == 0xF8 + (u \ndiv (64 * 64 * 64 * 64));
  464. c1 == 0x80 + ((u \ndiv (64 * 64 * 64)) \nmod 64);
  465. c2 == 0x80 + ((u \ndiv (64 * 64)) \nmod 64);
  466. c3 == 0x80 + ((u \ndiv 64) \nmod 64);
  467. c4 == 0x80 + (u \nmod 64)}
  468. EXTENDED_UTF8_SHORTEST_5byte (5, u, c0, c1, c2, c3, c4, ~1) of
  469. EXTENDED_UTF8_CHAR (5, u, c0, c1, c2, c3, c4, ~1)
  470. //
  471. | {u, c0, c1, c2, c3, c4, c5 : int |
  472. 0x3FFFFFF < u; u <= 0x7FFFFFFF;
  473. c0 == 0xFC + (u \ndiv (64 * 64 * 64 * 64 * 64));
  474. c1 == 0x80 + ((u \ndiv (64 * 64 * 64 * 64)) \nmod 64);
  475. c2 == 0x80 + ((u \ndiv (64 * 64 * 64)) \nmod 64);
  476. c3 == 0x80 + ((u \ndiv (64 * 64)) \nmod 64);
  477. c4 == 0x80 + ((u \ndiv 64) \nmod 64);
  478. c5 == 0x80 + (u \nmod 64)}
  479. EXTENDED_UTF8_SHORTEST_6byte (6, u, c0, c1, c2, c3, c4, c5) of
  480. EXTENDED_UTF8_CHAR (6, u, c0, c1, c2, c3, c4, c5)
  481.  
  482. extern prfun
  483. extended_utf8_shortest_is_char :
  484. {n : int} {u : int} {c0, c1, c2, c3, c4, c5 : int}
  485. EXTENDED_UTF8_SHORTEST (n, u, c0, c1, c2, c3, c4, c5) -<prf>
  486. EXTENDED_UTF8_CHAR (n, u, c0, c1, c2, c3, c4, c5)
  487.  
  488. extern prfun
  489. lemma_extended_utf8_shortest_length :
  490. {n : int} {u : int} {c0, c1, c2, c3, c4, c5 : int}
  491. EXTENDED_UTF8_SHORTEST (n, u, c0, c1, c2, c3, c4, c5) -<prf>
  492. [n == extended_utf8_shortest_length u] void
  493.  
  494. extern fun {}
  495. encode_extended_utf8_character :
  496. {u : nat | u <= 0x7FFFFFFF}
  497. int u -<>
  498. [n : int] [c0, c1, c2, c3, c4, c5 : int]
  499. @(EXTENDED_UTF8_SHORTEST (n, u, c0, c1, c2, c3, c4, c5) |
  500. int n, int c0, int c1, int c2, int c3, int c4, int c5)
  501.  
  502. (*------------------------------------------------------------------*)
  503. //
  504. // A valid UTF-8 character is one that encodes a valid Unicode
  505. // code point and is not overlong.
  506. //
  507.  
  508. dataprop UTF8_CHAR_INVALID_CASES (c0 : int, c1 : int, c2 : int, c3 : int) =
  509. // The cases are not mutually exclusive.
  510. | {c0, c1, c2, c3 : int | extended_utf8_character_length c0 == ~1}
  511. // We might not be using this case, presently (has that changed?),
  512. // but it is included for completeness.
  513. UTF8_CHAR_INVALID_bad_c0 (c0, c1, c2, c3)
  514. | {c0, c1, c2, c3 : int | 2 <= extended_utf8_character_length c0;
  515. ~(is_valid_utf8_continuation_byte c1)}
  516. UTF8_CHAR_INVALID_bad_c1 (c0, c1, c2, c3)
  517. | {c0, c1, c2, c3 : int | 3 <= extended_utf8_character_length c0;
  518. ~(is_valid_utf8_continuation_byte c2)}
  519. UTF8_CHAR_INVALID_bad_c2 (c0, c1, c2, c3)
  520. | {c0, c1, c2, c3 : int | extended_utf8_character_length c0 == 4;
  521. ~(is_valid_utf8_continuation_byte c3)}
  522. UTF8_CHAR_INVALID_bad_c3 (c0, c1, c2, c3)
  523. | {c0, c1, c2, c3 : int |
  524. extended_utf8_character_length c0 == 2;
  525. extended_utf8_char_2byte_decoding (c0, c1) <= 0x7F}
  526. UTF8_CHAR_INVALID_invalid_2byte (c0, c1, c2, c3)
  527. | {c0, c1, c2, c3 : int |
  528. extended_utf8_character_length c0 == 3
  529. && (extended_utf8_char_3byte_decoding (c0, c1, c2) <= 0x7FF
  530. || ~(is_valid_unicode_code_point
  531. (extended_utf8_char_3byte_decoding (c0, c1, c2))))}
  532. UTF8_CHAR_INVALID_invalid_3byte (c0, c1, c2, c3)
  533. | {c0, c1, c2, c3 : int |
  534. extended_utf8_character_length c0 == 4
  535. && (extended_utf8_char_4byte_decoding (c0, c1, c2, c3) <= 0xFFFF
  536. || ~(is_valid_unicode_code_point
  537. (extended_utf8_char_4byte_decoding (c0, c1, c2, c3))))}
  538. UTF8_CHAR_INVALID_invalid_4byte (c0, c1, c2, c3)
  539.  
  540. dataprop UTF8_CHAR_VALID_BYTES (c0 : int, c1 : int, c2 : int, c3 : int) =
  541. | {c0 : int | 0 <= c0 && c0 <= 0x7F}
  542. UTF8_CHAR_VALID_BYTES_1byte (c0, ~1, ~1, ~1)
  543. | {c0, c1 : int | 0xC2 <= c0 && c0 <= 0xDF;
  544. is_valid_utf8_continuation_byte c1}
  545. UTF8_CHAR_VALID_BYTES_2byte (c0, c1, ~1, ~1)
  546. | {c0, c1, c2 : int | (0xE1 <= c0 && c0 <= 0xEC)
  547. || c0 == 0xEE
  548. || c0 == 0xEF
  549. || (c0 == 0xE0 && 0xA0 <= c1)
  550. || (c0 == 0xED && c1 < 0xA0);
  551. is_valid_utf8_continuation_byte c1;
  552. is_valid_utf8_continuation_byte c2}
  553. UTF8_CHAR_VALID_BYTES_3byte (c0, c1, c2, ~1)
  554. | {c0, c1, c2, c3 : int | (0xF1 <= c0 && c0 <= 0xF3)
  555. || (c0 == 0xF0 && 0x90 <= c1)
  556. || (c0 == 0xF4 && c1 < 0x90);
  557. is_valid_utf8_continuation_byte c1;
  558. is_valid_utf8_continuation_byte c2;
  559. is_valid_utf8_continuation_byte c3}
  560. UTF8_CHAR_VALID_BYTES_4byte (c0, c1, c2, c3)
  561.  
  562. dataprop UTF8_CHAR_INVALID_BYTES (c0 : int, c1 : int, c2 : int, c3 : int) =
  563. | // This should never occur.
  564. {c0 : int | is_extended_utf8_1byte_first_byte c0}
  565. UTF8_CHAR_INVALID_BYTES_1byte (c0, ~1, ~1, ~1)
  566. | {c0, c1 : int | is_extended_utf8_2byte_first_byte c0;
  567. c0 == 0xC0 || c0 == 0xC1 ||
  568. is_invalid_utf8_continuation_byte c1}
  569. UTF8_CHAR_INVALID_BYTES_2byte (c0, c1, ~1, ~1)
  570. | {c0, c1, c2 : int | is_extended_utf8_3byte_first_byte c0;
  571. (c0 == 0xE0 && c1 < 0xA0) ||
  572. (c0 == 0xED && 0xA0 <= c1) ||
  573. is_invalid_utf8_continuation_byte c1 ||
  574. is_invalid_utf8_continuation_byte c2}
  575. UTF8_CHAR_INVALID_BYTES_3byte (c0, c1, c2, ~1)
  576. | {c0, c1, c2, c3 : int | is_extended_utf8_4byte_first_byte c0;
  577. 0xF4 < c0 ||
  578. (c0 == 0xF0 && c1 < 0x90) ||
  579. (c0 == 0xF4 && 0x90 <= c1) ||
  580. is_invalid_utf8_continuation_byte c1 ||
  581. is_invalid_utf8_continuation_byte c2 ||
  582. is_invalid_utf8_continuation_byte c3}
  583. UTF8_CHAR_INVALID_BYTES_4byte (c0, c1, c2, c3)
  584. | {c0, c1, c2, c3 : int | ~(is_extended_utf8_1byte_first_byte c0);
  585. ~(is_extended_utf8_2byte_first_byte c0);
  586. ~(is_extended_utf8_3byte_first_byte c0);
  587. ~(is_extended_utf8_4byte_first_byte c0)}
  588. UTF8_CHAR_INVALID_BYTES_bad_c0 (c0, c1, c2, c3)
  589.  
  590. dataprop UTF8_CHAR_VALIDITY (n : int, u : int, c0 : int, c1 : int,
  591. c2 : int, c3 : int, b : bool) =
  592. | {n : int} {u : int | is_valid_unicode_code_point u}
  593. {c0, c1, c2, c3 : int}
  594. UTF8_CHAR_valid (n, u, c0, c1, c2, c3, true) of
  595. (EXTENDED_UTF8_SHORTEST (n, u, c0, c1, c2, c3, ~1, ~1),
  596. UTF8_CHAR_VALID_BYTES (c0, c1, c2, c3))
  597. | {n : int} {u : int} {c0, c1, c2, c3 : int}
  598. UTF8_CHAR_invalid (n, u, c0, c1, c2, c3, false) of
  599. (UTF8_CHAR_INVALID_CASES (c0, c1, c2, c3),
  600. UTF8_CHAR_INVALID_BYTES (c0, c1, c2, c3))
  601.  
  602. propdef UTF8_CHAR_VALID (n : int, u : int, c0 : int, c1 : int,
  603. c2 : int, c3 : int) =
  604. UTF8_CHAR_VALIDITY (n, u, c0, c1, c2, c3, true)
  605.  
  606. propdef UTF8_CHAR_INVALID (c0 : int, c1 : int, c2 : int, c3 : int) =
  607. [n : int] [u : int] UTF8_CHAR_VALIDITY (n, u, c0, c1, c2, c3, false)
  608.  
  609. extern prfun
  610. utf8_char_valid_implies_shortest :
  611. {n : int} {u : int} {c0, c1, c2, c3 : int}
  612. UTF8_CHAR_VALID (n, u, c0, c1, c2, c3) -<prf>
  613. EXTENDED_UTF8_SHORTEST (n, u, c0, c1, c2, c3, ~1, ~1)
  614.  
  615. extern prfun
  616. lemma_valid_utf8_character_1byte :
  617. {u, c0 : int |
  618. is_extended_utf8_1byte_first_byte c0;
  619. u == extended_utf8_char_1byte_decoding c0;
  620. 0 <= u; u <= 0x7F}
  621. () -<prf> UTF8_CHAR_VALID (1, u, c0, ~1, ~1, ~1)
  622.  
  623. extern prfun
  624. lemma_valid_utf8_character_2byte :
  625. {u, c0, c1 : int |
  626. is_extended_utf8_2byte_first_byte c0;
  627. is_valid_utf8_continuation_byte c1;
  628. u == extended_utf8_char_2byte_decoding (c0, c1);
  629. 0x7F < u; u <= 0x7FF}
  630. () -<prf> UTF8_CHAR_VALID (2, u, c0, c1, ~1, ~1)
  631.  
  632. extern prfun
  633. lemma_valid_utf8_character_3byte :
  634. {u, c0, c1, c2 : int |
  635. is_extended_utf8_3byte_first_byte c0;
  636. is_valid_utf8_continuation_byte c1;
  637. is_valid_utf8_continuation_byte c2;
  638. u == extended_utf8_char_3byte_decoding (c0, c1, c2);
  639. 0x7FF < u; u <= 0xFFFF;
  640. //
  641. // Exclude the UTF-16 surrogate halves.
  642. //
  643. ~(0xD800 <= u && u < 0xE000)}
  644. () -<prf> UTF8_CHAR_VALID (3, u, c0, c1, c2, ~1)
  645.  
  646. extern prfun
  647. lemma_valid_utf8_character_4byte :
  648. {u, c0, c1, c2, c3 : int |
  649. is_extended_utf8_4byte_first_byte c0;
  650. is_valid_utf8_continuation_byte c1;
  651. is_valid_utf8_continuation_byte c2;
  652. is_valid_utf8_continuation_byte c3;
  653. u == extended_utf8_char_4byte_decoding (c0, c1, c2, c3);
  654. 0xFFFF < u; u <= 0x10FFFF}
  655. () -<prf> UTF8_CHAR_VALID (4, u, c0, c1, c2, c3)
  656.  
  657. extern prfun
  658. utf8_character_1byte_valid_bytes :
  659. // This does not really do anything, but is included
  660. // for completeness.
  661. {u, c0 : int | is_extended_utf8_1byte_first_byte c0}
  662. UTF8_CHAR_VALID (1, u, c0, ~1, ~1, ~1) -<prf> void
  663.  
  664. extern prfun
  665. utf8_character_2byte_valid_bytes :
  666. {u, c0, c1 : int | is_extended_utf8_2byte_first_byte c0}
  667. UTF8_CHAR_VALID (2, u, c0, c1, ~1, ~1) -<prf>
  668. [0xC2 <= c0; c0 <= 0xDF;
  669. is_valid_utf8_continuation_byte c1]
  670. void
  671.  
  672. extern prfun
  673. utf8_character_3byte_valid_bytes :
  674. {u, c0, c1, c2 : int | is_extended_utf8_3byte_first_byte c0}
  675. UTF8_CHAR_VALID (3, u, c0, c1, c2, ~1) -<prf>
  676. [(0xE1 <= c0 && c0 <= 0xEC)
  677. || c0 == 0xEE
  678. || c0 == 0xEF
  679. || (c0 == 0xE0 && 0xA0 <= c1)
  680. || (c0 == 0xED && c1 < 0xA0);
  681. is_valid_utf8_continuation_byte c1;
  682. is_valid_utf8_continuation_byte c2]
  683. void
  684.  
  685. extern prfun
  686. utf8_character_4byte_valid_bytes :
  687. {u, c0, c1, c2, c3 : int | is_extended_utf8_4byte_first_byte c0}
  688. UTF8_CHAR_VALID (4, u, c0, c1, c2, c3) -<prf>
  689. [(0xF1 <= c0 && c0 <= 0xF3)
  690. || (c0 == 0xF0 && 0x90 <= c1)
  691. || (c0 == 0xF4 && c1 < 0x90);
  692. is_valid_utf8_continuation_byte c1;
  693. is_valid_utf8_continuation_byte c2;
  694. is_valid_utf8_continuation_byte c3]
  695. void
  696.  
  697. extern prfun
  698. utf8_character_1byte_invalid_bytes :
  699. // This does not really do anything, but is included
  700. // for completeness.
  701. {c0 : int | is_extended_utf8_1byte_first_byte c0}
  702. UTF8_CHAR_INVALID (c0, ~1, ~1, ~1) -<prf> void
  703.  
  704. extern prfun
  705. utf8_character_2byte_invalid_bytes :
  706. {c0, c1 : int | is_extended_utf8_2byte_first_byte c0}
  707. UTF8_CHAR_INVALID (c0, c1, ~1, ~1) -<prf>
  708. [c0 == 0xC0 || c0 == 0xc1 || is_invalid_utf8_continuation_byte c1]
  709. void
  710.  
  711. extern prfun
  712. utf8_character_3byte_invalid_bytes :
  713. {c0, c1, c2 : int | is_extended_utf8_3byte_first_byte c0}
  714. UTF8_CHAR_INVALID (c0, c1, c2, ~1) -<prf>
  715. [(c0 == 0xE0 && c1 < 0xA0) ||
  716. (c0 == 0xED && 0xA0 <= c1) ||
  717. is_invalid_utf8_continuation_byte c1 ||
  718. is_invalid_utf8_continuation_byte c2]
  719. void
  720.  
  721. extern prfun
  722. utf8_character_4byte_invalid_bytes :
  723. {c0, c1, c2, c3 : int | is_extended_utf8_4byte_first_byte c0}
  724. UTF8_CHAR_INVALID (c0, c1, c2, c3) -<prf>
  725. [0xF4 < c0 ||
  726. (c0 == 0xF0 && c1 < 0x90) ||
  727. (c0 == 0xF4 && 0x90 <= c1) ||
  728. is_invalid_utf8_continuation_byte c1 ||
  729. is_invalid_utf8_continuation_byte c2 ||
  730. is_invalid_utf8_continuation_byte c3]
  731. void
  732.  
  733. extern fun {}
  734. is_valid_utf8_character_1byte :
  735. {c0 : int | is_extended_utf8_1byte_first_byte c0}
  736. int c0 -<>
  737. [b : bool | b == true] [u : int]
  738. (UTF8_CHAR_VALIDITY (1, u, c0, ~1, ~1, ~1, b) | bool b)
  739.  
  740. extern fun {}
  741. is_valid_utf8_character_2byte :
  742. {c0, c1 : int | is_extended_utf8_2byte_first_byte c0}
  743. (int c0, int c1) -<>
  744. [b : bool] [u : int]
  745. (UTF8_CHAR_VALIDITY (2, u, c0, c1, ~1, ~1, b) | bool b)
  746.  
  747. extern fun {}
  748. is_valid_utf8_character_3byte :
  749. {c0, c1, c2 : int | is_extended_utf8_3byte_first_byte c0}
  750. (int c0, int c1, int c2) -<>
  751. [b : bool] [u : int]
  752. (UTF8_CHAR_VALIDITY (3, u, c0, c1, c2, ~1, b) | bool b)
  753.  
  754. extern fun {}
  755. is_valid_utf8_character_4byte :
  756. {c0, c1, c2, c3 : int | is_extended_utf8_4byte_first_byte c0}
  757. (int c0, int c1, int c2, int c3) -<>
  758. [b : bool] [u : int]
  759. (UTF8_CHAR_VALIDITY (4, u, c0, c1, c2, c3, b) | bool b)
  760.  
  761. extern fun {}
  762. decode_utf8_1byte :
  763. {c0 : int | is_extended_utf8_1byte_first_byte c0}
  764. int c0 -<> [u : int | 0 <= u; u <= 0x7F] int u
  765.  
  766. extern fun {}
  767. decode_utf8_2byte :
  768. {c0, c1 : int | 0xC2 <= c0; c0 <= 0xDF;
  769. is_valid_utf8_continuation_byte c1}
  770. (int c0, int c1) -<> [u : int | 0x7F < u; u <= 0x7FF] int u
  771.  
  772. extern fun {}
  773. decode_utf8_3byte :
  774. {c0, c1, c2 : int | (0xE1 <= c0 && c0 <= 0xEC)
  775. || c0 == 0xEE
  776. || c0 == 0xEF
  777. || (c0 == 0xE0 && 0xA0 <= c1)
  778. || (c0 == 0xED && c1 < 0xA0);
  779. is_valid_utf8_continuation_byte c1;
  780. is_valid_utf8_continuation_byte c2}
  781. (int c0, int c1, int c2) -<>
  782. [u : int | 0x7FF < u; u <= 0xFFFF; u < 0xD800 || 0xE000 <= u] int u
  783.  
  784. extern fun {}
  785. decode_utf8_4byte :
  786. {c0, c1, c2, c3 : int | (0xF1 <= c0 && c0 <= 0xF3)
  787. || (c0 == 0xF0 && 0x90 <= c1)
  788. || (c0 == 0xF4 && c1 < 0x90);
  789. is_valid_utf8_continuation_byte c1;
  790. is_valid_utf8_continuation_byte c2;
  791. is_valid_utf8_continuation_byte c3}
  792. (int c0, int c1, int c2, int c3) -<>
  793. [u : int | 0xFFFF < u; u <= 0x10FFFF] int u
  794.  
  795. extern fun {}
  796. encode_utf8_character :
  797. {u : int | is_valid_unicode_code_point u}
  798. int u -<>
  799. [n : int]
  800. [c0, c1, c2, c3 : int | extended_utf8_char_length_relation (c0, n)]
  801. @(UTF8_CHAR_VALID (n, u, c0, c1, c2, c3) |
  802. int n, int c0, int c1, int c2, int c3)
  803.  
  804. (*------------------------------------------------------------------*)
  805.  
  806. #define utf8_decode_next_error_char ~1
  807.  
  808. (* Returns @(utf8_decode_next_error_char, ..) on error. *)
  809. extern fun
  810. utf8_array_decode_next {utf8len : int | 0 < utf8len}
  811. {n_utf8arr : int | utf8len <= n_utf8arr}
  812. {i : int | i < utf8len}
  813. (utf8len : size_t utf8len,
  814. utf8arr : &(@[char][n_utf8arr]),
  815. i : size_t i) :<>
  816. [c : int | is_valid_unicode_code_point c ||
  817. c == utf8_decode_next_error_char]
  818. [i_next : int | i_next == i + 1 || i_next == i + 2 ||
  819. i_next == i + 3 || i_next == i + 4;
  820. i_next <= utf8len]
  821. @(int c, size_t i_next)
  822.  
  823. extern fun
  824. utf8_string_decode_next {utf8len : int | 0 < utf8len}
  825. {n_utf8str : int | utf8len <= n_utf8str}
  826. {i : int | i < utf8len}
  827. (utf8len : size_t utf8len,
  828. utf8str : string n_utf8str,
  829. i : size_t i) :<>
  830. [c : int | is_valid_unicode_code_point c ||
  831. c == utf8_decode_next_error_char]
  832. [i_next : int | i_next == i + 1 || i_next == i + 2 ||
  833. i_next == i + 3 || i_next == i + 4;
  834. i_next <= utf8len]
  835. @(int c, size_t i_next)
  836.  
  837. overload utf8_decode_next with utf8_array_decode_next
  838. overload utf8_decode_next with utf8_string_decode_next
  839.  
  840. (*###################### IMPLEMENTATION ############################*)
  841.  
  842. // Integer division by 64 is equivalent to shifting right
  843. // by 6 bits.
  844.  
  845. extern prfun _shift_right_twelve :
  846. {x, y, z : nat | y == (x \ndiv 64);
  847. z == (y \ndiv 64)}
  848. (int x, int y, int z) -<prf> [z == (x \ndiv (64 * 64))] void
  849.  
  850. primplement _shift_right_twelve (x, y, z) =
  851. ()
  852.  
  853. extern prfun _shift_right_eighteen :
  854. {x, y, z, u : nat | y == (x \ndiv 64);
  855. z == (y \ndiv 64);
  856. u == (z \ndiv 64)}
  857. (int x, int y, int z, int u) -<prf> [u == (x \ndiv (64 * 64 * 64))] void
  858.  
  859. primplement _shift_right_eighteen (x, y, z, u) = ()
  860.  
  861.  
  862. extern prfun _shift_right_twenty_four :
  863. {x, y, z, u, v : nat | y == (x \ndiv 64);
  864. z == (y \ndiv 64);
  865. u == (z \ndiv 64);
  866. v == (u \ndiv 64)}
  867. (int x, int y, int z, int u, int v) -<prf>
  868. [v == (x \ndiv (64 * 64 * 64 * 64))] void
  869.  
  870. primplement _shift_right_twenty_four (x, y, z, u, v) = ()
  871.  
  872. (*------------------------------------------------------------------*)
  873.  
  874. implement {}
  875. is_valid_unicode_code_point u =
  876. ((0x0 <= u) * (u < 0xD800)) + ((0xE000 <= u) * (u <= 0x10FFFF))
  877.  
  878. (*------------------------------------------------------------------*)
  879.  
  880. primplement
  881. extended_utf8_char_length_relation_to_length () = ()
  882.  
  883. primplement
  884. extended_utf8_char_length_to_length_relation () = ()
  885.  
  886. primplement
  887. utf8_char_length_relation_to_length () = ()
  888.  
  889. primplement
  890. utf8_char_length_to_length_relation () = ()
  891.  
  892. (*------------------------------------------------------------------*)
  893.  
  894. implement {}
  895. is_valid_utf8_continuation_byte c =
  896. (0x80 <= c) * (c <= 0xBF)
  897.  
  898. (*------------------------------------------------------------------*)
  899.  
  900. primplement
  901. decode_extended_utf8_istot {n} {c0, c1, c2, c3, c4, c5} () =
  902. sif n == 1 then
  903. let
  904. prfn
  905. make_pf {u : int | u == extended_utf8_char_1byte_decoding (c0)}
  906. () :<prf>
  907. EXTENDED_UTF8_CHAR (n, u, c0, c1, c2, c3, c4, c5) =
  908. EXTENDED_UTF8_CHAR_1byte ()
  909. stadef u = extended_utf8_char_1byte_decoding (c0)
  910. in
  911. make_pf {u} ()
  912. end
  913. else sif n == 2 then
  914. let
  915. prfn
  916. make_pf {u : int | u == extended_utf8_char_2byte_decoding (c0, c1)}
  917. () :<prf>
  918. EXTENDED_UTF8_CHAR (n, u, c0, c1, c2, c3, c4, c5) =
  919. EXTENDED_UTF8_CHAR_2byte ()
  920. stadef u = extended_utf8_char_2byte_decoding (c0, c1)
  921. in
  922. make_pf {u} ()
  923. end
  924. else sif n == 3 then
  925. let
  926. prfn
  927. make_pf {u : int | u == extended_utf8_char_3byte_decoding (c0, c1, c2)}
  928. () :<prf>
  929. EXTENDED_UTF8_CHAR (n, u, c0, c1, c2, c3, c4, c5) =
  930. EXTENDED_UTF8_CHAR_3byte ()
  931. stadef u = extended_utf8_char_3byte_decoding (c0, c1, c2)
  932. in
  933. make_pf {u} ()
  934. end
  935. else sif n == 4 then
  936. let
  937. prfn
  938. make_pf {u : int |
  939. u == extended_utf8_char_4byte_decoding (c0, c1, c2, c3)}
  940. () :<prf>
  941. EXTENDED_UTF8_CHAR (n, u, c0, c1, c2, c3, c4, c5) =
  942. EXTENDED_UTF8_CHAR_4byte ()
  943. stadef u = extended_utf8_char_4byte_decoding (c0, c1, c2, c3)
  944. in
  945. make_pf {u} ()
  946. end
  947. else sif n == 5 then
  948. let
  949. prfn
  950. make_pf {u : int |
  951. u == extended_utf8_char_5byte_decoding (c0, c1, c2, c3, c4)}
  952. () :<prf>
  953. EXTENDED_UTF8_CHAR (n, u, c0, c1, c2, c3, c4, c5) =
  954. EXTENDED_UTF8_CHAR_5byte ()
  955. stadef u = extended_utf8_char_5byte_decoding (c0, c1, c2, c3, c4)
  956. in
  957. make_pf {u} ()
  958. end
  959. else
  960. let
  961. prfn
  962. make_pf {u : int |
  963. u == extended_utf8_char_6byte_decoding (c0, c1, c2, c3, c4, c5)}
  964. () :<prf>
  965. EXTENDED_UTF8_CHAR (n, u, c0, c1, c2, c3, c4, c5) =
  966. EXTENDED_UTF8_CHAR_6byte ()
  967. stadef u = extended_utf8_char_6byte_decoding (c0, c1, c2, c3, c4, c5)
  968. in
  969. make_pf {u} ()
  970. end
  971.  
  972. primplement
  973. decode_extended_utf8_isfun {na} (pf_a, pf_b) =
  974. sif na == 1 then
  975. let
  976. prval EXTENDED_UTF8_CHAR_1byte () = pf_a
  977. prval EXTENDED_UTF8_CHAR_1byte () = pf_b
  978. in
  979. end
  980. else sif na == 2 then
  981. let
  982. prval EXTENDED_UTF8_CHAR_2byte () = pf_a
  983. prval EXTENDED_UTF8_CHAR_2byte () = pf_b
  984. in
  985. end
  986. else sif na == 3 then
  987. let
  988. prval EXTENDED_UTF8_CHAR_3byte () = pf_a
  989. prval EXTENDED_UTF8_CHAR_3byte () = pf_b
  990. in
  991. end
  992. else sif na == 4 then
  993. let
  994. prval EXTENDED_UTF8_CHAR_4byte () = pf_a
  995. prval EXTENDED_UTF8_CHAR_4byte () = pf_b
  996. in
  997. end
  998. else sif na == 5 then
  999. let
  1000. prval EXTENDED_UTF8_CHAR_5byte () = pf_a
  1001. prval EXTENDED_UTF8_CHAR_5byte () = pf_b
  1002. in
  1003. end
  1004. else
  1005. let
  1006. prval EXTENDED_UTF8_CHAR_6byte () = pf_a
  1007. prval EXTENDED_UTF8_CHAR_6byte () = pf_b
  1008. in
  1009. end
  1010.  
  1011.  
  1012. primplement
  1013. lemma_extended_utf8_char_length pf_char =
  1014. case+ pf_char of
  1015. | EXTENDED_UTF8_CHAR_1byte () => ()
  1016. | EXTENDED_UTF8_CHAR_2byte () => ()
  1017. | EXTENDED_UTF8_CHAR_3byte () => ()
  1018. | EXTENDED_UTF8_CHAR_4byte () => ()
  1019. | EXTENDED_UTF8_CHAR_5byte () => ()
  1020. | EXTENDED_UTF8_CHAR_6byte () => ()
  1021.  
  1022. implement {}
  1023. decode_extended_utf8_1byte c0 =
  1024. (EXTENDED_UTF8_CHAR_1byte () | c0)
  1025.  
  1026. implement {}
  1027. decode_extended_utf8_2byte (c0, c1) =
  1028. let
  1029. val u0 = c0 - 0xC0
  1030. val u1 = c1 - 0x80
  1031. in
  1032. (EXTENDED_UTF8_CHAR_2byte () | 64 * u0 + u1)
  1033. end
  1034.  
  1035. implement {}
  1036. decode_extended_utf8_3byte (c0, c1, c2) =
  1037. let
  1038. val u0 = c0 - 0xE0
  1039. val u1 = c1 - 0x80
  1040. val u2 = c2 - 0x80
  1041. in
  1042. (EXTENDED_UTF8_CHAR_3byte () | 64 * (64 * u0 + u1) + u2)
  1043. end
  1044.  
  1045. implement {}
  1046. decode_extended_utf8_4byte (c0, c1, c2, c3) =
  1047. let
  1048. val u0 = c0 - 0xF0
  1049. val u1 = c1 - 0x80
  1050. val u2 = c2 - 0x80
  1051. val u3 = c3 - 0x80
  1052. in
  1053. (EXTENDED_UTF8_CHAR_4byte () | 64 * (64 * (64 * u0 + u1) + u2) + u3)
  1054. end
  1055.  
  1056. implement {}
  1057. decode_extended_utf8_5byte (c0, c1, c2, c3, c4) =
  1058. let
  1059. val u0 = c0 - 0xF8
  1060. val u1 = c1 - 0x80
  1061. val u2 = c2 - 0x80
  1062. val u3 = c3 - 0x80
  1063. val u4 = c4 - 0x80
  1064. in
  1065. (EXTENDED_UTF8_CHAR_5byte () |
  1066. 64 * (64 * (64 * (64 * u0 + u1) + u2) + u3) + u4)
  1067. end
  1068.  
  1069. implement {}
  1070. decode_extended_utf8_6byte (c0, c1, c2, c3, c4, c5) =
  1071. let
  1072. val u0 = c0 - 0xFC
  1073. val u1 = c1 - 0x80
  1074. val u2 = c2 - 0x80
  1075. val u3 = c3 - 0x80
  1076. val u4 = c4 - 0x80
  1077. val u5 = c5 - 0x80
  1078. in
  1079. (EXTENDED_UTF8_CHAR_6byte () |
  1080. 64 * (64 * (64 * (64 * (64 * u0 + u1) + u2) + u3) + u4) + u5)
  1081. end
  1082.  
  1083. (*------------------------------------------------------------------*)
  1084.  
  1085. primplement
  1086. extended_utf8_shortest_is_char pf_shortest =
  1087. case+ pf_shortest of
  1088. | EXTENDED_UTF8_SHORTEST_1byte pf_char => pf_char
  1089. | EXTENDED_UTF8_SHORTEST_2byte pf_char => pf_char
  1090. | EXTENDED_UTF8_SHORTEST_3byte pf_char => pf_char
  1091. | EXTENDED_UTF8_SHORTEST_4byte pf_char => pf_char
  1092. | EXTENDED_UTF8_SHORTEST_5byte pf_char => pf_char
  1093. | EXTENDED_UTF8_SHORTEST_6byte pf_char => pf_char
  1094.  
  1095. primplement
  1096. lemma_extended_utf8_shortest_length pf_shortest =
  1097. case+ pf_shortest of
  1098. | EXTENDED_UTF8_SHORTEST_1byte pf_char =>
  1099. { prval EXTENDED_UTF8_CHAR_1byte () = pf_char }
  1100. | EXTENDED_UTF8_SHORTEST_2byte pf_char =>
  1101. { prval EXTENDED_UTF8_CHAR_2byte () = pf_char }
  1102. | EXTENDED_UTF8_SHORTEST_3byte pf_char =>
  1103. { prval EXTENDED_UTF8_CHAR_3byte () = pf_char }
  1104. | EXTENDED_UTF8_SHORTEST_4byte pf_char =>
  1105. { prval EXTENDED_UTF8_CHAR_4byte () = pf_char }
  1106. | EXTENDED_UTF8_SHORTEST_5byte pf_char =>
  1107. { prval EXTENDED_UTF8_CHAR_5byte () = pf_char }
  1108. | EXTENDED_UTF8_SHORTEST_6byte pf_char =>
  1109. { prval EXTENDED_UTF8_CHAR_6byte () = pf_char }
  1110.  
  1111. implement {}
  1112. encode_extended_utf8_character u =
  1113. if u <= 0x7F then
  1114. let
  1115. val c0 = u
  1116. in
  1117. @(EXTENDED_UTF8_SHORTEST_1byte (EXTENDED_UTF8_CHAR_1byte ()) |
  1118. 1, c0, ~1, ~1, ~1, ~1, ~1)
  1119. end
  1120. else if u <= 0x7FF then
  1121. let
  1122. val c1 = 0x80 + (u \nmod 64)
  1123. val u1 = u \ndiv 64
  1124. val c0 = 0xC0 + u1
  1125. in
  1126. @(EXTENDED_UTF8_SHORTEST_2byte (EXTENDED_UTF8_CHAR_2byte ()) |
  1127. 2, c0, c1, ~1, ~1, ~1, ~1)
  1128. end
  1129. else if u <= 0xFFFF then
  1130. let
  1131. val c2 = 0x80 + (u \nmod 64)
  1132. val u1 = u \ndiv 64
  1133. val c1 = 0x80 + (u1 \nmod 64)
  1134. val u2 = u1 \ndiv 64
  1135. val c0 = 0xE0 + u2
  1136. in
  1137. @(EXTENDED_UTF8_SHORTEST_3byte (EXTENDED_UTF8_CHAR_3byte ()) |
  1138. 3, c0, c1, c2, ~1, ~1, ~1)
  1139. end
  1140. else if u <= 0x1FFFFF then
  1141. let
  1142. val c3 = 0x80 + (u \nmod 64)
  1143. val u1 = u \ndiv 64
  1144. val c2 = 0x80 + (u1 \nmod 64)
  1145. val u2 = u1 \ndiv 64
  1146. val c1 = 0x80 + (u2 \nmod 64)
  1147. val u3 = u2 \ndiv 64
  1148. val c0 = 0xF0 + u3
  1149. prval () = _shift_right_twelve (u, u1, u2)
  1150. in
  1151. @(EXTENDED_UTF8_SHORTEST_4byte (EXTENDED_UTF8_CHAR_4byte ()) |
  1152. 4, c0, c1, c2, c3, ~1, ~1)
  1153. end
  1154. else if u <= 0x3FFFFFF then
  1155. let
  1156. val c4 = 0x80 + (u \nmod 64)
  1157. val u1 = u \ndiv 64
  1158. val c3 = 0x80 + (u1 \nmod 64)
  1159. val u2 = u1 \ndiv 64
  1160. val c2 = 0x80 + (u2 \nmod 64)
  1161. val u3 = u2 \ndiv 64
  1162. val c1 = 0x80 + (u3 \nmod 64)
  1163. val u4 = u3 \ndiv 64
  1164. val c0 = 0xF8 + u4
  1165. prval () = _shift_right_twelve (u, u1, u2)
  1166. prval () = _shift_right_eighteen (u, u1, u2, u3)
  1167. in
  1168. @(EXTENDED_UTF8_SHORTEST_5byte (EXTENDED_UTF8_CHAR_5byte ()) |
  1169. 5, c0, c1, c2, c3, c4, ~1)
  1170. end
  1171. else
  1172. let
  1173. val c5 = 0x80 + (u \nmod 64)
  1174. val u1 = u \ndiv 64
  1175. val c4 = 0x80 + (u1 \nmod 64)
  1176. val u2 = u1 \ndiv 64
  1177. val c3 = 0x80 + (u2 \nmod 64)
  1178. val u3 = u2 \ndiv 64
  1179. val c2 = 0x80 + (u3 \nmod 64)
  1180. val u4 = u3 \ndiv 64
  1181. val c1 = 0x80 + (u4 \nmod 64)
  1182. val u5 = u4 \ndiv 64
  1183. val c0 = 0xFC + u5
  1184. prval () = _shift_right_twelve (u, u1, u2)
  1185. prval () = _shift_right_eighteen (u, u1, u2, u3)
  1186. prval () = _shift_right_twenty_four (u, u1, u2, u3, u4)
  1187. in
  1188. @(EXTENDED_UTF8_SHORTEST_6byte (EXTENDED_UTF8_CHAR_6byte ()) |
  1189. 6, c0, c1, c2, c3, c4, c5)
  1190. end
  1191.  
  1192. (*------------------------------------------------------------------*)
  1193.  
  1194. primplement
  1195. utf8_char_valid_implies_shortest pf_valid =
  1196. case+ pf_valid of
  1197. | UTF8_CHAR_valid (pf_shortest, _) => pf_shortest
  1198.  
  1199. primplement
  1200. lemma_valid_utf8_character_1byte {u, c0} () =
  1201. let
  1202. prfn
  1203. make_pf {u : int | u == extended_utf8_char_1byte_decoding (c0)}
  1204. () :<prf> EXTENDED_UTF8_CHAR (1, u, c0, ~1, ~1, ~1, ~1, ~1) =
  1205. EXTENDED_UTF8_CHAR_1byte ()
  1206. prval pf_char = make_pf {u} ()
  1207. prval pf_shortest = EXTENDED_UTF8_SHORTEST_1byte pf_char
  1208. prval pf_bytes = UTF8_CHAR_VALID_BYTES_1byte ()
  1209. prval pf_valid = UTF8_CHAR_valid (pf_shortest, pf_bytes)
  1210. in
  1211. pf_valid
  1212. end
  1213.  
  1214. primplement
  1215. lemma_valid_utf8_character_2byte {u, c0, c1} () =
  1216. let
  1217. prfn
  1218. make_pf {u : int | u == extended_utf8_char_2byte_decoding (c0, c1)}
  1219. () :<prf> EXTENDED_UTF8_CHAR (2, u, c0, c1, ~1, ~1, ~1, ~1) =
  1220. EXTENDED_UTF8_CHAR_2byte ()
  1221. prval pf_char = make_pf {u} ()
  1222. prval pf_shortest = EXTENDED_UTF8_SHORTEST_2byte pf_char
  1223. prval pf_bytes = UTF8_CHAR_VALID_BYTES_2byte ()
  1224. prval pf_valid = UTF8_CHAR_valid (pf_shortest, pf_bytes)
  1225. in
  1226. pf_valid
  1227. end
  1228.  
  1229. primplement
  1230. lemma_valid_utf8_character_3byte {u, c0, c1, c2} () =
  1231. let
  1232. prfn
  1233. make_pf {u : int | u == extended_utf8_char_3byte_decoding (c0, c1, c2)}
  1234. () :<prf> EXTENDED_UTF8_CHAR (3, u, c0, c1, c2, ~1, ~1, ~1) =
  1235. EXTENDED_UTF8_CHAR_3byte ()
  1236. prval pf_char = make_pf {u} ()
  1237. prfn lemma_c1 () :<prf> [c1 == 0x80 + ((u \ndiv 64) \nmod 64)] void =
  1238. {
  1239. // Convert to Horner form.
  1240. stadef u1 = 64 * (64 * (c0 - 0xE0) + (c1 - 0x80)) + (c2 - 0x80)
  1241. prval EQINT () = eqint_make {u, u1} ()
  1242. }
  1243. prval () = lemma_c1 ()
  1244. prval pf_shortest = EXTENDED_UTF8_SHORTEST_3byte pf_char
  1245. prval pf_bytes = UTF8_CHAR_VALID_BYTES_3byte ()
  1246. prval pf_valid = UTF8_CHAR_valid (pf_shortest, pf_bytes)
  1247. in
  1248. pf_valid
  1249. end
  1250.  
  1251. primplement
  1252. lemma_valid_utf8_character_4byte {u, c0, c1, c2, c3} () =
  1253. let
  1254. prfn
  1255. make_pf {u : int | u == extended_utf8_char_4byte_decoding (c0, c1, c2, c3)}
  1256. () :<prf> EXTENDED_UTF8_CHAR (4, u, c0, c1, c2, c3, ~1, ~1) =
  1257. EXTENDED_UTF8_CHAR_4byte ()
  1258. prval pf_char = make_pf {u} ()
  1259. prfn lemma_c1 () :<prf> [c1 == 0x80 + ((u \ndiv (64 * 64)) \nmod 64)] void =
  1260. {
  1261. prval EQINT () =
  1262. eqint_make {(64 * 64 * (c0 - 0xE0)) \ndiv (64 * 64), c0 - 0xE0} ()
  1263. prval pfd = divmod_istot {u \ndiv (64 * 64), 64} ()
  1264. prval pfm = divmod_elim pfd
  1265. prval () = mul_elim pfm
  1266. }
  1267. prval () = lemma_c1 ()
  1268. prfn lemma_c2 () :<prf> [c2 == 0x80 + ((u \ndiv 64) \nmod 64)] void =
  1269. {
  1270. // Convert to Horner form.
  1271. stadef u1 = 64 * (64 * (64 * (c0 - 0xF0) + (c1 - 0x80)) + (c2 - 0x80))
  1272. + (c3 - 0x80)
  1273. prval EQINT () = eqint_make {u, u1} ()
  1274. }
  1275. prval () = lemma_c2 ()
  1276. prval pf_shortest = EXTENDED_UTF8_SHORTEST_4byte pf_char
  1277. prval pf_bytes = UTF8_CHAR_VALID_BYTES_4byte ()
  1278. prval pf_valid = UTF8_CHAR_valid (pf_shortest, pf_bytes)
  1279. in
  1280. pf_valid
  1281. end
  1282.  
  1283. primplement
  1284. utf8_character_1byte_valid_bytes pf_valid = ()
  1285.  
  1286. primplement
  1287. utf8_character_2byte_valid_bytes pf_valid =
  1288. {
  1289. prval UTF8_CHAR_valid (_, pf_bytes) = pf_valid
  1290. prval UTF8_CHAR_VALID_BYTES_2byte () = pf_bytes
  1291. }
  1292.  
  1293. primplement
  1294. utf8_character_3byte_valid_bytes pf_valid =
  1295. {
  1296. prval UTF8_CHAR_valid (_, pf_bytes) = pf_valid
  1297. prval UTF8_CHAR_VALID_BYTES_3byte () = pf_bytes
  1298. }
  1299.  
  1300. primplement
  1301. utf8_character_4byte_valid_bytes pf_valid =
  1302. {
  1303. prval UTF8_CHAR_valid (_, pf_bytes) = pf_valid
  1304. prval UTF8_CHAR_VALID_BYTES_4byte () = pf_bytes
  1305. }
  1306.  
  1307. primplement
  1308. utf8_character_1byte_invalid_bytes pf_invalid =
  1309. {
  1310. prval UTF8_CHAR_invalid (_, pf_bytes) = pf_invalid
  1311. prval UTF8_CHAR_INVALID_BYTES_1byte () = pf_bytes
  1312. }
  1313.  
  1314. primplement
  1315. utf8_character_2byte_invalid_bytes pf_invalid =
  1316. {
  1317. prval UTF8_CHAR_invalid (_, pf_bytes) = pf_invalid
  1318. prval UTF8_CHAR_INVALID_BYTES_2byte () = pf_bytes
  1319. }
  1320.  
  1321. primplement
  1322. utf8_character_3byte_invalid_bytes pf_invalid =
  1323. {
  1324. prval UTF8_CHAR_invalid (_, pf_bytes) = pf_invalid
  1325. prval UTF8_CHAR_INVALID_BYTES_3byte () = pf_bytes
  1326. }
  1327.  
  1328. primplement
  1329. utf8_character_4byte_invalid_bytes pf_invalid =
  1330. {
  1331. prval UTF8_CHAR_invalid (_, pf_bytes) = pf_invalid
  1332. prval UTF8_CHAR_INVALID_BYTES_4byte () = pf_bytes
  1333. }
  1334.  
  1335. implement {}
  1336. is_valid_utf8_character_1byte {c0} c0 =
  1337. let
  1338. stadef u = extended_utf8_char_1byte_decoding c0
  1339. in
  1340. (lemma_valid_utf8_character_1byte {u, c0} () | true)
  1341. end
  1342.  
  1343. implement {}
  1344. is_valid_utf8_character_2byte {c0, c1} (c0, c1) =
  1345. let
  1346. stadef u = extended_utf8_char_2byte_decoding (c0, c1)
  1347. in
  1348. if not (is_valid_utf8_continuation_byte c1) then
  1349. (UTF8_CHAR_invalid (UTF8_CHAR_INVALID_bad_c1 (),
  1350. UTF8_CHAR_INVALID_BYTES_2byte ()) |
  1351. false)
  1352. else if c0 < 0xC2 then
  1353. // The sequence is overlong.
  1354. (UTF8_CHAR_invalid (UTF8_CHAR_INVALID_invalid_2byte (),
  1355. UTF8_CHAR_INVALID_BYTES_2byte ()) |
  1356. false)
  1357. else
  1358. (lemma_valid_utf8_character_2byte {u, c0, c1} () | true)
  1359. end
  1360.  
  1361. implement {}
  1362. is_valid_utf8_character_3byte {c0, c1, c2} (c0, c1, c2) =
  1363. let
  1364. stadef u = extended_utf8_char_3byte_decoding (c0, c1, c2)
  1365. in
  1366. if not (is_valid_utf8_continuation_byte c1) then
  1367. (UTF8_CHAR_invalid (UTF8_CHAR_INVALID_bad_c1 (),
  1368. UTF8_CHAR_INVALID_BYTES_3byte ()) |
  1369. false)
  1370. else if not (is_valid_utf8_continuation_byte c2) then
  1371. (UTF8_CHAR_invalid (UTF8_CHAR_INVALID_bad_c2 (),
  1372. UTF8_CHAR_INVALID_BYTES_3byte ()) |
  1373. false)
  1374. else if (0xE1 <= c0) * (c0 <= 0xEC) then
  1375. (lemma_valid_utf8_character_3byte {u, c0, c1, c2} () | true)
  1376. else if c0 = 0xEE then
  1377. (lemma_valid_utf8_character_3byte {u, c0, c1, c2} () | true)
  1378. else if c0 = 0xEF then
  1379. (lemma_valid_utf8_character_3byte {u, c0, c1, c2} () | true)
  1380. else if (c0 = 0xE0) * (0xA0 <= c1) then
  1381. (lemma_valid_utf8_character_3byte {u, c0, c1, c2} () | true)
  1382. else if (c0 = 0xED) * (c1 < 0xA0) then
  1383. (lemma_valid_utf8_character_3byte {u, c0, c1, c2} () | true)
  1384. else
  1385. // Either the sequence is overlong or it decodes to
  1386. // an invalid code point.
  1387. (UTF8_CHAR_invalid (UTF8_CHAR_INVALID_invalid_3byte (),
  1388. UTF8_CHAR_INVALID_BYTES_3byte ()) |
  1389. false)
  1390. end
  1391.  
  1392. implement {}
  1393. is_valid_utf8_character_4byte {c0, c1, c2, c3} (c0, c1, c2, c3) =
  1394. let
  1395. stadef u = extended_utf8_char_4byte_decoding (c0, c1, c2, c3)
  1396. in
  1397. if not (is_valid_utf8_continuation_byte c1) then
  1398. (UTF8_CHAR_invalid (UTF8_CHAR_INVALID_bad_c1 (),
  1399. UTF8_CHAR_INVALID_BYTES_4byte ()) |
  1400. false)
  1401. else if not (is_valid_utf8_continuation_byte c2) then
  1402. (UTF8_CHAR_invalid (UTF8_CHAR_INVALID_bad_c2 (),
  1403. UTF8_CHAR_INVALID_BYTES_4byte ()) |
  1404. false)
  1405. else if not (is_valid_utf8_continuation_byte c3) then
  1406. (UTF8_CHAR_invalid (UTF8_CHAR_INVALID_bad_c3 (),
  1407. UTF8_CHAR_INVALID_BYTES_4byte ()) |
  1408. false)
  1409. else if (0xF1 <= c0) * (c0 <= 0xF3) then
  1410. (lemma_valid_utf8_character_4byte {u, c0, c1, c2, c3} () | true)
  1411. else if (c0 = 0xF0) * (0x90 <= c1) then
  1412. (lemma_valid_utf8_character_4byte {u, c0, c1, c2, c3} () | true)
  1413. else if (c0 = 0xF4) * (c1 < 0x90) then
  1414. (lemma_valid_utf8_character_4byte {u, c0, c1, c2, c3} () | true)
  1415. else
  1416. // Either the sequence is overlong or it decodes to
  1417. // an invalid code point.
  1418. (UTF8_CHAR_invalid (UTF8_CHAR_INVALID_invalid_4byte (),
  1419. UTF8_CHAR_INVALID_BYTES_4byte ()) |
  1420. false)
  1421. end
  1422.  
  1423. implement {}
  1424. decode_utf8_1byte c0 = c0
  1425.  
  1426. implement {}
  1427. decode_utf8_2byte (c0, c1) =
  1428. let
  1429. val u0 = c0 - 0xC0
  1430. val u1 = c1 - 0x80
  1431. in
  1432. 64 * u0 + u1
  1433. end
  1434.  
  1435. implement {}
  1436. decode_utf8_3byte (c0, c1, c2) =
  1437. let
  1438. val u0 = c0 - 0xE0
  1439. val u1 = c1 - 0x80
  1440. val u2 = c2 - 0x80
  1441. in
  1442. 64 * (64 * u0 + u1) + u2
  1443. end
  1444.  
  1445. implement {}
  1446. decode_utf8_4byte (c0, c1, c2, c3) =
  1447. let
  1448. val u0 = c0 - 0xF0
  1449. val u1 = c1 - 0x80
  1450. val u2 = c2 - 0x80
  1451. val u3 = c3 - 0x80
  1452. in
  1453. 64 * (64 * (64 * u0 + u1) + u2) + u3
  1454. end
  1455.  
  1456. implement {}
  1457. encode_utf8_character {u} u =
  1458. if u <= 0x7F then
  1459. let
  1460. val c0 = u
  1461. stadef c0 = u
  1462. in
  1463. @(lemma_valid_utf8_character_1byte {u, c0} () | 1, c0, ~1, ~1, ~1)
  1464. end
  1465. else if u <= 0x7FF then
  1466. let
  1467. val c1 = 0x80 + (u \nmod 64)
  1468. val u1 = u \ndiv 64
  1469. val c0 = 0xC0 + u1
  1470. stadef c1 = 0x80 + (u \nmod 64)
  1471. stadef u1 = u \ndiv 64
  1472. stadef c0 = 0xC0 + u1
  1473. in
  1474. @(lemma_valid_utf8_character_2byte {u, c0, c1} () | 2, c0, c1, ~1, ~1)
  1475. end
  1476. else if u <= 0xFFFF then
  1477. let
  1478. val c2 = 0x80 + (u \nmod 64)
  1479. val u1 = u \ndiv 64
  1480. val c1 = 0x80 + (u1 \nmod 64)
  1481. val u2 = u1 \ndiv 64
  1482. val c0 = 0xE0 + u2
  1483. stadef c2 = 0x80 + (u \nmod 64)
  1484. stadef u1 = u \ndiv 64
  1485. stadef c1 = 0x80 + (u1 \nmod 64)
  1486. stadef u2 = u1 \ndiv 64
  1487. stadef c0 = 0xE0 + u2
  1488. in
  1489. @(lemma_valid_utf8_character_3byte {u, c0, c1, c2} () | 3, c0, c1, c2, ~1)
  1490. end
  1491. else
  1492. let
  1493. val c3 = 0x80 + (u \nmod 64)
  1494. val u1 = u \ndiv 64
  1495. val c2 = 0x80 + (u1 \nmod 64)
  1496. val u2 = u1 \ndiv 64
  1497. val c1 = 0x80 + (u2 \nmod 64)
  1498. val u3 = u2 \ndiv 64
  1499. val c0 = 0xF0 + u3
  1500. stadef c3 = 0x80 + (u \nmod 64)
  1501. stadef u1 = u \ndiv 64
  1502. stadef c2 = 0x80 + (u1 \nmod 64)
  1503. stadef u2 = u1 \ndiv 64
  1504. stadef c1 = 0x80 + (u2 \nmod 64)
  1505. stadef u3 = u2 \ndiv 64
  1506. stadef c0 = 0xF0 + u3
  1507. prval () = _shift_right_twelve (u, u1, u2)
  1508. in
  1509. @(lemma_valid_utf8_character_4byte {u, c0, c1, c2, c3} () |
  1510. 4, c0, c1, c2, c3)
  1511. end
  1512.  
  1513. (*------------------------------------------------------------------*)
  1514.  
  1515. implement
  1516. utf8_array_decode_next (utf8len, utf8arr, i) =
  1517. let
  1518. macdef getchr (j) = g1ofg0 (char2u2i (utf8arr[,(j)]))
  1519. macdef error_return = @(utf8_decode_next_error_char, i + i2sz 1)
  1520.  
  1521. prval _ = lemma_g1uint_param (i)
  1522.  
  1523. val c0 = getchr (i)
  1524. in
  1525. if 0x00 <= c0 &&& c0 <= 0xFF then
  1526. let
  1527. val seqlen = utf8_character_length c0
  1528. in
  1529. case+ seqlen of
  1530. | 1 => @(c0, i + i2sz 1)
  1531.  
  1532. | 2 =>
  1533. if utf8len < i + i2sz 2 then
  1534. error_return
  1535. else
  1536. let
  1537. val c1 = getchr (i + i2sz 1)
  1538. val (pf | valid) =
  1539. is_valid_utf8_character_2byte (c0, c1)
  1540. in
  1541. if valid then
  1542. let
  1543. prval _ = utf8_character_2byte_valid_bytes pf
  1544. val code_point = decode_utf8_2byte (c0, c1)
  1545. in
  1546. @(code_point, i + i2sz 2)
  1547. end
  1548. else
  1549. error_return
  1550. end
  1551.  
  1552. | 3 =>
  1553. if utf8len < i + i2sz 3 then
  1554. error_return
  1555. else
  1556. let
  1557. val c1 = getchr (i + i2sz 1)
  1558. val c2 = getchr (i + i2sz 2)
  1559. val (pf | valid) =
  1560. is_valid_utf8_character_3byte (c0, c1, c2)
  1561. in
  1562. if valid then
  1563. let
  1564. prval _ = utf8_character_3byte_valid_bytes pf
  1565. val code_point = decode_utf8_3byte (c0, c1, c2)
  1566. in
  1567. @(code_point, i + i2sz 3)
  1568. end
  1569. else
  1570. error_return
  1571. end
  1572.  
  1573. | 4 =>
  1574. if utf8len < i + i2sz 4 then
  1575. error_return
  1576. else
  1577. let
  1578. val c1 = getchr (i + i2sz 1)
  1579. val c2 = getchr (i + i2sz 2)
  1580. val c3 = getchr (i + i2sz 3)
  1581. val (pf | valid) =
  1582. is_valid_utf8_character_4byte (c0, c1, c2, c3)
  1583. in
  1584. if valid then
  1585. let
  1586. prval _ = utf8_character_4byte_valid_bytes pf
  1587. val code_point = decode_utf8_4byte (c0, c1, c2, c3)
  1588. in
  1589. @(code_point, i + i2sz 4)
  1590. end
  1591. else
  1592. error_return
  1593. end
  1594.  
  1595. | _ => error_return
  1596. end
  1597. else
  1598. (* This branch should never be run on a system
  1599. with 8-bit char. *)
  1600. error_return
  1601. end
  1602.  
  1603. implement
  1604. utf8_string_decode_next {..} {n_utf8str} (utf8len, utf8str, i) =
  1605. let
  1606. val [p : addr] p = string2ptr utf8str
  1607. val (pf, consume_pf | p) =
  1608. $UNSAFE.ptr1_vtake{@[char][n_utf8str]} p
  1609. val result = utf8_array_decode_next (utf8len, !p, i)
  1610. prval _ = consume_pf pf
  1611. in
  1612. result
  1613. end
  1614.  
  1615. (*###################### DEMONSTRATION #############################*)
  1616.  
  1617. fn
  1618. encode_LATIN_CAPITAL_LETTER_A () : void =
  1619. {
  1620. val u = 0x0041
  1621.  
  1622. (* Return both a proof of valid encoding and the encoding. *)
  1623. val (pf_valid | n, c0, c1, c2, c3) = encode_utf8_character (u)
  1624.  
  1625. (* Verify the encoding. *)
  1626. val _ = assertloc (n = 1)
  1627. val _ = assertloc (c0 = 0x41)
  1628. }
  1629.  
  1630. fn
  1631. decode_LATIN_CAPITAL_LETTER_A () : void =
  1632. {
  1633. val str = "\x41\0"
  1634. val n = length str
  1635. val (c, i) = utf8_decode_next (n, str, i2sz 0)
  1636.  
  1637. (* Verify that the decoding is correct. *)
  1638. val _ = assertloc (c = 0x0041)
  1639.  
  1640. (* Verify that the next index is 1. *)
  1641. val _ = assertloc (i = i2sz 1)
  1642. }
  1643.  
  1644. fn
  1645. encode_LATIN_SMALL_LETTER_O_WITH_DIAERESIS () : void =
  1646. {
  1647. val u = 0x00F6
  1648.  
  1649. (* Return both a proof of valid encoding and the encoding. *)
  1650. val (pf_valid | n, c0, c1, c2, c3) = encode_utf8_character (u)
  1651.  
  1652. (* Verify the encoding. *)
  1653. val _ = assertloc (n = 2)
  1654. val _ = assertloc (c0 = 0xC3)
  1655. val _ = assertloc (c1 = 0xB6)
  1656. }
  1657.  
  1658. fn
  1659. decode_LATIN_SMALL_LETTER_O_WITH_DIAERESIS () : void =
  1660. {
  1661. val str = "\xC3\xB6\0"
  1662. val n = length str
  1663. val (c, i) = utf8_decode_next (n, str, i2sz 0)
  1664.  
  1665. (* Verify that the decoding is correct. *)
  1666. val _ = assertloc (c = 0x00F6)
  1667.  
  1668. (* Verify that the next index is 2. *)
  1669. val _ = assertloc (i = i2sz 2)
  1670. }
  1671.  
  1672. fn
  1673. encode_CYRILLIC_CAPITAL_LETTER_ZHE () : void =
  1674. {
  1675. val u = 0x0416
  1676.  
  1677. (* Return both a proof of valid encoding and the encoding. *)
  1678. val (pf_valid | n, c0, c1, c2, c3) = encode_utf8_character (u)
  1679.  
  1680. (* Verify the encoding. *)
  1681. val _ = assertloc (n = 2)
  1682. val _ = assertloc (c0 = 0xD0)
  1683. val _ = assertloc (c1 = 0x96)
  1684. }
  1685.  
  1686. fn
  1687. decode_CYRILLIC_CAPITAL_LETTER_ZHE () : void =
  1688. {
  1689. val str = "\xD0\x96\0"
  1690. val n = length str
  1691. val (c, i) = utf8_decode_next (n, str, i2sz 0)
  1692.  
  1693. (* Verify that the decoding is correct. *)
  1694. val _ = assertloc (c = 0x0416)
  1695.  
  1696. (* Verify that the next index is 2. *)
  1697. val _ = assertloc (i = i2sz 2)
  1698. }
  1699.  
  1700. fn
  1701. encode_EURO_SIGN () : void =
  1702. {
  1703. val u = 0x20AC
  1704.  
  1705. (* Return both a proof of valid encoding and the encoding. *)
  1706. val (pf_valid | n, c0, c1, c2, c3) = encode_utf8_character (u)
  1707.  
  1708. (* Verify the encoding. *)
  1709. val _ = assertloc (n = 3)
  1710. val _ = assertloc (c0 = 0xE2)
  1711. val _ = assertloc (c1 = 0x82)
  1712. val _ = assertloc (c2 = 0xAC)
  1713. }
  1714.  
  1715. fn
  1716. decode_EURO_SIGN () : void =
  1717. {
  1718. val str = "\xE2\x82\xAC\0"
  1719. val n = length str
  1720. val (c, i) = utf8_decode_next (n, str, i2sz 0)
  1721.  
  1722. (* Verify that the decoding is correct. *)
  1723. val _ = assertloc (c = 0x20AC)
  1724.  
  1725. (* Verify that the next index is 3. *)
  1726. val _ = assertloc (i = i2sz 3)
  1727. }
  1728.  
  1729. fn
  1730. encode_MUSICAL_SYMBOL_G_CLEF () : void =
  1731. {
  1732. val u = 0x1D11E
  1733.  
  1734. (* Return both a proof of valid encoding and the encoding. *)
  1735. val (pf_valid | n, c0, c1, c2, c3) = encode_utf8_character (u)
  1736.  
  1737. (* Verify the encoding. *)
  1738. val _ = assertloc (n = 4)
  1739. val _ = assertloc (c0 = 0xF0)
  1740. val _ = assertloc (c1 = 0x9D)
  1741. val _ = assertloc (c2 = 0x84)
  1742. val _ = assertloc (c3 = 0x9E)
  1743. }
  1744.  
  1745. fn
  1746. decode_MUSICAL_SYMBOL_G_CLEF () : void =
  1747. {
  1748. val str = "\xF0\x9D\x84\x9E\0"
  1749. val n = length str
  1750. val (c, i) = utf8_decode_next (n, str, i2sz 0)
  1751.  
  1752. (* Verify that the decoding is correct. *)
  1753. val _ = assertloc (c = 0x1D11E)
  1754.  
  1755. (* Verify that the next index is 4. *)
  1756. val _ = assertloc (i = i2sz 4)
  1757. }
  1758.  
  1759. implement
  1760. main0 () =
  1761. begin
  1762. encode_LATIN_CAPITAL_LETTER_A ();
  1763. decode_LATIN_CAPITAL_LETTER_A ();
  1764.  
  1765. encode_LATIN_SMALL_LETTER_O_WITH_DIAERESIS ();
  1766. decode_LATIN_SMALL_LETTER_O_WITH_DIAERESIS ();
  1767.  
  1768. encode_CYRILLIC_CAPITAL_LETTER_ZHE ();
  1769. decode_CYRILLIC_CAPITAL_LETTER_ZHE ();
  1770.  
  1771. encode_EURO_SIGN ();
  1772. decode_EURO_SIGN ();
  1773.  
  1774. encode_MUSICAL_SYMBOL_G_CLEF ();
  1775. decode_MUSICAL_SYMBOL_G_CLEF ();
  1776.  
  1777. println! ("SUCCESS")
  1778. end
  1779.  
Advertisement
Add Comment
Please, Sign In to add comment