Prolog MessagePack library

This module contains DCGs for packing & unpacking MessagePack data.

author: - James Cash
license: - GPLv3
bug: - Can't write out floats (can unpack single-precision, but not write) */
To be done: - double-precision floats

21msgpack(none) --> nil, !. 22msgpack(str(S)) --> str(str(S)), !. 23msgpack(list(L)) --> array(list(L)), !. 24msgpack(dict(D)) --> map(dict(D)), !. 25msgpack(bin(X)) --> bin(bin(X)), !. 26msgpack(date(Y,M,D,H,Mn,S,Off,TZ,DST)) --> 27 { Dt = date(Y,M,D,H,Mn,S,Off,TZ,DST) }, timestamp(dt(Dt)), !. 28msgpack(ext(T, X)) --> ext(ext(T, X)), !. 29msgpack(single(N)) --> floating(single(N)), !. 30msgpack(B) --> bool(B), !. 31msgpack(N) --> int(N), !. 32 33nil --> [0xc0]. 34 35bool(false)--> [0xc2]. 36bool(true) --> [0xc3]. 37 38% Integer types 39int(N) --> fixnum(N). 40int(N) --> uint8(N). 41int(N) --> uint16(N). 42int(N) --> uint32(N). 43int(N) --> uint64(N). 44int(N) --> int8(N). 45int(N) --> int16(N). 46int(N) --> int32(N). 47int(N) --> int64(N). 48 49% positive fixnum stores 7-bit positive integer 50fixnum(N) --> 51 [N], 52 { N =< 0b0111 1111, N >= 0, ! }. 53% negative fixnum stores 5-bit negative integer 54fixnum(N) --> 55 [X], 56 { X in 224..255, 57 N #< 0, 58 N #>= -0b00011111, 59 X #= 0b11100000 \/ V, 60 V in 0..31, 61 Inv #= 0b11111 - V, 62 N #= -Inv - 1 }. 63% uint8 stores an 8-bit unsigned integer 64uint8(N) --> 65 [0xcc, N], 66 { N in 0..255 }. 67%uint16 stores a 16-bit big-endian unsigned integer 68uint16(N) --> 69 { integer(N), N >= 0, N < 1<<17, ! }, 70 [0xcd, A, B], 71 { B is N /\ 0xff, 72 A is (N /\ 0xff00) >> 8 }. 73uint16(N) --> 74 [0xcd, A, B], 75 { N #> 0, N #< 1 << 17, 76 N is A<<8 + B }. 77% uint32 stores a 32-bit big-endian unsigned integer 78uint32(N) --> 79 % special-case for when given an integer; we can be much faster 80 % about how we pack it than the brute-force search that clp(fd) 81 % would take 82 { integer(N), N >= 1>>17, N < 1<<33, ! }, 83 [0xce, A, B, C, D], 84 { D is N /\ 0xff, 85 C is (N /\ 0xff00) >> 8, 86 B is (N /\ 0xff0000) >> 16, 87 A is (N /\ 0xff000000) >> 24 }. 88uint32(N) --> 89 [0xce, A, B, C, D], 90 { N #> 0, N #< 1 << 33, 91 N is D + C << 8 + B << 16 + A << 24 }. 92% uint64 stores a 64-bit big-endian unsigned integer 93uint64(N) --> 94 % special-case for when given an integer; we can be much faster 95 % about how we pack it than the brute-force search that clp(fd) 96 % would take 97 { integer(N), N >= 1>>33, N < 1<<65, ! }, 98 [0xcf, A, B, C, D, E, F, G, H], 99 { H is N /\ 0xff, 100 G is (N /\ 0xff00) >> 8, 101 F is (N /\ 0xff0000) >> 16, 102 E is (N /\ 0xff000000) >> 24, 103 D is (N /\ 0xff00000000) >> 32, 104 C is (N /\ 0xff0000000000) >> 40, 105 B is (N /\ 0xff000000000000) >> 48, 106 A is (N /\ 0xff00000000000000) >> 56 }. 107uint64(N) --> 108 [0xcf, A, B, C, D, E, F, G, H], 109 { N #> 0, N #< 1 << 65, 110 N is H + G<<8 + F<<16 + E<<24 + D<<32 + C<<40 + B<<48 + A<<56 }. 111% int8 stores an 8-bit signed integer 112% argument bytes are always unsigned, so need to convert 113% NB. 0x80 = 0b1000 0000 114int8(N) --> % neg int8 115 [0xd0, A], 116 { N in (-128)..(-1), 117 A in 0..255, 118 A #>= 0x80, 119 Inv #= 0xff - A, 120 N #= -Inv - 1 }. 121int8(N) --> % pos int8 122 [0xd0, N], 123 { N in 0..127 }. 124% int16 125int16(N) --> 126 { integer(N), N =< 0x7fff, N >= -0x8000 }, 127 [0xd1, A, B], 128 { unsigned16_signed16(X, N), 129 A is (X /\ 0xff00) >> 8, 130 B is (X /\ 0x00ff) }. 131int16(N) --> % neg int16 132 [0xd1, A, B], 133 { A #>= 0x80, 134 N in (-0x8000)..(-1), 135 X is A<<8 + B, 136 Inv is 0xffff - X, 137 N is -Inv - 1 }. 138int16(N) --> % pos int16 139 [0xd1, A, B], 140 { N in 0..0x7fff, 141 N is A<<8 + B }. 142% int32 143int32(N) --> 144 { integer(N), N >= -0x8000_0000, N < 0x8000_0000, ! }, 145 [0xd2, A, B, C, D], 146 { unsigned32_signed32(X, N), 147 D is X /\ 0xff, 148 C is (X /\ 0xff00) >> 8, 149 B is (X /\ 0xff0000) >> 16, 150 A is (X /\ 0xff000000) >> 24 }. 151int32(N) --> % neg int32 152 [0xd2, A, B, C, D], 153 { N in (-0x8000_0000)..(-1), 154 A #>= 0x80, 155 X is A<<24 + B<<16 + C<<8 + D, 156 Inv is 0xffff_ffff - X, 157 N is -Inv - 1 }. 158int32(N) --> % pos int32 159 [0xd2, A, B, C, D], 160 { N in 0..(0x7fff_ffff), 161 N is A<<24 + B<<16 + C<<8 + D }. 162% int64 163int64(N) --> 164 { integer(N), ! }, 165 [0xd3, A, B, C, D, E, F, G, H], 166 { unsigned64_signed64(X, N), 167 H is X /\ 0xff, 168 G is (X /\ 0xff00) >> 8, 169 F is (X /\ 0xff0000) >> 16, 170 E is (X /\ 0xff000000) >> 24, 171 D is (X /\ 0xff00000000) >> 32, 172 C is (X /\ 0xff0000000000) >> 40, 173 B is (X /\ 0xff000000000000) >> 48, 174 A is (X /\ 0xff00000000000000) >> 56 }. 175int64(N) --> % neg int64 176 { N in (-0x8000_0000_0000_0000)..(-1) }, 177 [0xd3, A, B, C, D, E, F, G, H], 178 { [A,B,C,D,E,F,G,H] ins 0..255, 179 A #>= 0x80, 180 X is A<<56 + B<<48 + C<<40 + D<<32 + E<<24 + F<<16 + G<<8 + H, 181 Inv is 0xffff_ffff_ffff_ffff - X, 182 N is -Inv - 1 }. 183int64(N) --> % pos int64 184 [0xd3, A, B, C, D, E, F, G, H], 185 { [A,B,C,D,E,F,G,H] ins 0..255, 186 N in 0..(0x7fff_ffff_ffff_ffff), 187 N is A<<56 + B<<48 + C<<40 + D<<32 + E<<24 + F<<16 + G<<8 + H }. 188 189% Floats 190% TODO: use clp(r) for this? 191float_bits(_, N, -1, _, N) :- !. 192float_bits(Bs, N, Bit, Div, Ans) :- 193 Nn is N + (getbit(Bs, Bit) * Div), 194 DivN is Div / 2, 195 BitN is Bit - 1, 196 float_bits(Bs, Nn, BitN, DivN, Ans). 197float_bits(Bs, N) :- float_bits(Bs, 1, 22, 0.5, N). 198 199floating(single(Fl)) --> 200 [0xca, A, B, C, D], 201 { [A,B,C,D] ins 0..255, 202 Sign is (-1)**((A /\ 0b1000_0000) >> 7), 203 Exp_ is (A /\ 0b0111_1111) << 1 + (B /\ 0b1000_0000) >> 7, 204 Exp is 2**(Exp_ - 127), 205 FracBits is (B /\ 0b0111_1111)<<16 + C<<8 + D, 206 float_bits(FracBits, Frac), 207 Fl is Sign * Exp * Frac }. 208% TODO: gurf 209% float(double(N)) --> 210% [0xcb, A, B, C, D, E, F, G, H], 211% { [A,B,C,D,E,F,G,H] ins 0..255 }. 212 213% Strings 214 215% string helper predicates 216str_header(N, 0xd9) :- N < 1<<8. 217str_header(N, 0xda) :- N < 1<<16. 218str_header(N, 0xdb) :- N < 1<<32. 219 220string_pad_bytes([B], [B]). 221string_pad_bytes([B1, B2], [B1, B2]). 222string_pad_bytes([B1, B2, B3], [0, B1, B2, B3]). 223string_pad_bytes([B1, B2, B3, B4], [B1, B2, B3, B4]). 224 225str(str(S)) --> 226 { string(S), string_length(S, L), L =< 31, ! }, 227 [H|Bytes], 228 { H is 0b10100000 \/ L, 229 string_codes(S, Bytes) }. 230str(str(S)) --> 231 { string(S), string_length(S, L), L > 31, L < 1<<32, !, 232 str_header(L, H), 233 int_bytes(L, LenBytes_), 234 string_pad_bytes(LenBytes_, LenBytes), 235 !, 236 string_codes(S, Bytes), 237 append(LenBytes, Bytes, Packed) }, 238 [H|Packed]. 239str(str(S)) --> 240 [H|T], 241 { H in 0b1010_0000..0b1011_1111, 242 L is H /\ 0b0001_1111, 243 L in 0..31, 244 prefix(Bytes, T), 245 length(Bytes, L), 246 string_codes(S, Bytes) }. 247str(str(S)) --> 248 [0xd9,L|T], 249 { prefix(Bytes, T), 250 length(Bytes, L), 251 string_codes(S, Bytes) }. 252str(str(S)) --> 253 [0xda,A,B|T], 254 { prefix(Bytes, T), 255 length(Bytes, L), 256 L is A<<8 + B, 257 string_codes(S, Bytes) }. 258str(str(S)) --> 259 [0xdb,A,B,C,D|T], 260 { prefix(Bytes, T), 261 length(Bytes, L), 262 L is A<<24 + B<<16 + C<<8 + D, 263 string_codes(S, Bytes) }. 264 265% Bins i.e. byte arrays 266bin(bin(Data)) --> 267 [0xc4, Len|Data], 268 { length(Data, Len) }. 269bin(bin(Data)) --> 270 [0xc5, A, B|Data], 271 { Len is A<<8 + B, 272 length(Data, Len) }. 273bin(bin(Data)) --> 274 [0xc6, A, B, C, D|Data], 275 { Len is A<<24 + B<<16 + C<<8 + D, 276 length(Data, Len) }. 277 278% Arrays 279 280% Array helper predicates 281consume_msgpack_list([], [], 0) :- !. 282consume_msgpack_list([A|As], Bs, N) :- 283 msgpack(A, Bs, Rst), 284 !, 285 Nn is N - 1, 286 consume_msgpack_list(As, Rst, Nn). 287 288array_header(L, 0xdc) :- L < 1<<16. 289array_header(L, 0xdd) :- L < 1<<32. 290 291array_pad_bytes([B], [0, B]). 292array_pad_bytes([A, B], [A, B]). 293array_pad_bytes([A,B,C], [0,A,B,C]). 294array_pad_bytes([A,B,C,D], [A,B,C,D]). 295 296array(list(List)) --> 297 { is_list(List), length(List, Len), Len < 15, 298 !, 299 H is 0b10010000 + Len, 300 consume_msgpack_list(List, T, Len) }, 301 [H|T]. 302array(list(List)) --> 303 { is_list(List), length(List, Len), Len < 1<<32, 304 !, 305 array_header(Len, H), 306 int_bytes(Len, LenBytes_), 307 array_pad_bytes(LenBytes_, LenBytes), 308 !, 309 consume_msgpack_list(List, Packed, Len), 310 append(LenBytes, Packed, T) }, 311 [H|T]. 312array(list(List)) --> 313 [H], 314 { H in 0b1001_0000..0b1001_1111, 315 L is H /\ 0b0000_1111, 316 L in 0..15, 317 length(List, L) }, 318 msgpack_list(List, L). 319array(list(List)) --> 320 [0xdc,A,B], 321 { Len is A <<8 + B }, 322 msgpack_list(List, Len). 323array(list(List)) --> 324 [0xdd,A,B,C,D], 325 { Len is A <<24 + B<<16 + C<<8 + D }, 326 msgpack_list(List, Len). 327 328msgpack_list([], 0) --> []. 329msgpack_list([A|As], N) --> 330 msgpack(A), { Nn is N - 1 }, msgpack_list(As, Nn). 331 332% Maps 333% Need to use pairs insead of dicts, because dicts only support atom 334% or integer keys 335 336% map helper predicates 337consume_msgpack_dict([], [], 0) :- !. 338consume_msgpack_dict([K-V|KVs], Bs, N) :- 339 msgpack(K, Bs, Rst_), 340 msgpack(V, Rst_, Rst), 341 !, 342 Nn is N - 1, 343 consume_msgpack_dict(KVs, Rst, Nn). 344 345dict_header(L, 0xde) :- L < 1<<16. 346dict_header(L, 0xdf) :- L < 1<<32. 347 348map(dict(D)) --> 349 { is_list(D), length(D, L), L < 15, !, 350 H is 0b10000000 + L, 351 consume_msgpack_dict(D, T, L) }, 352 [H|T]. 353map(dict(D)) --> 354 { is_list(D), length(D, Len), Len < 1<<32, !, 355 dict_header(Len, H), 356 int_bytes(Len, LenBytes_), 357 array_pad_bytes(LenBytes_, LenBytes), 358 consume_msgpack_dict(D, Packed, Len), 359 append(LenBytes, Packed, T) }, 360 [H|T]. 361map(dict(D)) --> 362 [H|T], 363 { H in 0b10000000..0b10001111, 364 L is H /\ 0b0000_1111, 365 consume_msgpack_dict(D, T, L) }. 366map(dict(D)) --> 367 [0xde, A, B], 368 { Len is A<<8 + B }, 369 msgpack_dict(D, Len). 370map(dict(D)) --> 371 [0xdf, A, B, C, D], 372 { Len is A<<24 + B<<16 + C<<8 + D }, 373 msgpack_dict(D, Len). 374 375msgpack_dict([], 0) --> []. 376msgpack_dict([K-V|Ds], N) --> 377 msgpack(K), msgpack(V), 378 { Nn is N - 1 }, 379 msgpack_dict(Ds, Nn). 380 381 382% Extension types 383 384ext(ext(Type, [Data])) --> 385 [0xd4, Type, Data], 386 { Type in 0..0x7f }. 387ext(ext(Type, [A,B])) --> 388 [0xd5, Type, A, B], 389 { Type in 0..0x7f }. 390ext(ext(Type, [A,B,C,D])) --> 391 [0xd6, Type, A, B, C, D], 392 { Type in 0..0x7f }. 393ext(ext(Type, Data)) --> 394 [0xd7, Type|Data], 395 { Type in 0..0x7f }, 396 { length(Data, 8) }. 397ext(ext(Type, Data)) --> 398 [0xd8, Type|Data], 399 { Type in 0..0x7f }, 400 { length(Data, 16) }. 401ext(ext(Type, Data)) --> 402 [0xc7, Len, Type|Data], 403 { Type in 0..0x7f }, 404 { Len in 0..255, 405 length(Data, Len) }. 406ext(ext(Type, Data)) --> 407 [0xc8, A, B, Type|Data], 408 { Type in 0..0x7f }, 409 { Len #< 1<<17, 410 [A,B] ins 0..255, 411 Len #= A<<8 + B, 412 length(Data, Len) }. 413ext(ext(Type, Data)) --> 414 [0xc9, A, B, C, D, Type|Data], 415 { Type in 0..0x7f }, 416 { Len #< 1<<33, 417 [A,B,C,D] ins 0..255, 418 Len #= A<<24 + B<<16 + C<<8 + D, 419 length(Data, Len) }. 420 421% Timestamp extensions 422% timestamp32 stores number of seconds since 1970-01-01 00:00:00 UTC as uint32 423timestamp(dt(Dt)) --> 424 { ground(Dt) }, 425 [0xd6, 0xff, A, B, C, D], 426 { date_time_stamp(Dt, Tss), 427 Ts is truncate(Tss), 428 A is (Ts /\ 0xff00_0000) >> 24, 429 B is (Ts /\ 0x00ff_0000) >> 16, 430 C is (Ts /\ 0x0000_ff00) >> 8, 431 D is (Ts /\ 0x0000_00ff) >> 0 }. 432timestamp(dt(T)) --> 433 [0xd6, 0xff, A, B, C, D], 434 { Ts is A<<24 + B<<16 + C<<8 + D, 435 stamp_date_time(Ts, T, 'UTC') }. 436% timestamp 64 stores the number of seconds and nanoseconds that have 437% elapsed since epoch; nanosecond in a 30-bit unsigned int and seconds 438% in a 34-bit unsigned int 439timestamp(dt(T)) --> 440 % Can't use clp(fd) here, since we need to use floats... 441 [0xd7, 0xff, A, B, C, D, E, F, G, H], 442 { Tsn is float(A<<22 + B<<14 + C<<6 + (D /\ 0b1111_1100)>>6), 443 Tss is (D /\ 0b011) << 32 + E<<24 + F<<16 + G<<8 + H, 444 Tsn < 1e9, 445 Ts is Tss + (Tsn / 1e9), 446 stamp_date_time(Ts, T, 'UTC') }. 447% timestamp 96 stores the number of seconds and nanoseconds since 448% epoch; nanoseconds in a 32-bit unsigned int and seconds in a 64-bit 449% signed int 450timestamp(dt(T)) --> 451 [0xc7, 12, 0xff, Na, Nb, Nc, Nd, Sa, Sb, Sc, Sd, Se, Sf, Sg, Sh], 452 { Tn is float(Na<<24 + Nb<<16 + Nc<<8 + Nd), 453 Ts_ is Sa<<56 + Sb<<48 + Sc<<40 +Sd<<32 + Se<<24 + Sf<<16 + Sg<<8 + Sh, 454 unsigned64_signed64(Ts_, Ts), 455 Tn < 1e9, 456 Time is Ts + (Tn / 1e9), 457 stamp_date_time(Time, T, 'UTC') }. 458 459% helper predicates 460int_bytes(I, B) :- int_bytes(I, [], B). 461int_bytes(0, R, R). 462int_bytes(I, Bs, R) :- 463 Bl is I /\ 0xff, 464 In is I >> 8, 465 int_bytes(In, [Bl|Bs], R). 466 467unsigned16_signed16(Un, Si) :- 468 integer(Un), 469 Un >= 0x8000, 470 Inv is 0xffff - Un, 471 Si is -Inv - 1. 472unsigned16_signed16(Un, Si) :- 473 integer(Si), 474 Si < 0, 475 Inv is -Si - 1, 476 Un is 0xffff - Inv. 477unsigned16_signed16(Un, Un). 478 479unsigned32_signed32(Un, Si) :- 480 integer(Un), 481 Un >= 0x8000_0000, 482 Inv is 0xffff_ffff - Un, 483 Si is -Inv - 1. 484unsigned32_signed32(Un, Si) :- 485 integer(Si), 486 Si < 0, 487 Inv is -Si - 1, 488 Un is 0xffff_ffff - Inv. 489unsigned32_signed32(Un, Un). 490 491unsigned64_signed64(Un, Si) :- 492 integer(Un), 493 Un >= 0x8000_0000_0000_0000, 494 Inv is 0xffff_ffff_ffff_ffff - Un, 495 Si is -Inv - 1. 496unsigned64_signed64(Un, Si) :- 497 integer(Si), 498 Si < 0, 499 Inv is -Si - 1, 500 Un is 0xffff_ffff_ffff_ffff - Inv. 501unsigned64_signed64(Un, Un). 502 503% :- use_module(library(plunit)). 504% ?- load_test_files([]), run_tests.