Paste: uuid
Author: | mrjbq7 |
Mode: | factor |
Date: | Sat, 20 Dec 2008 05:59:28 |
Plain Text |
USING: alien.syntax alien.c-types byte-arrays
checksums checksums.md5 checksums.sha1 kernel
math math.parser math.ranges random unicode.case
sequences strings system ;
IN: uuid
<PRIVATE
: (timestamp)
micros 10 * HEX: 01b21dd213814000 +
[ -48 shift HEX: 0fff bitand ]
[ -32 shift HEX: ffff bitand ]
[ HEX: ffffffff bitand ] tri ;
: (hardware)
48 random-bits HEX: 010000000000 bitor ;
: (clock)
14 random-bits ;
: <uuid>
96 shift
[ 80 shift ] dip bitor
[ 64 shift ] dip bitor
[ 48 shift ] dip bitor
bitor ;
: (version)
[ HEX: c000 48 shift bitnot bitand
HEX: 8000 48 shift bitor
HEX: f000 64 shift bitnot bitand
] dip 76 shift bitor ;
: uuid>string
>hex 32 CHAR: 0 pad-left
CHAR: - 20 rot insert-nth
CHAR: - 16 rot insert-nth
CHAR: - 12 rot insert-nth
CHAR: - 8 rot insert-nth ;
: string>uuid
[ CHAR: - = not ] filter 16 base> ;
: uuid>byte-array
16 <byte-array> swap 0 15 1 <range>
[ dup 8 * neg [ swap dup ] dip
shift HEX: ff bitand rot roll
[ set-nth ] keep swap
] each drop reverse ;
: byte-array>uuid
[ >hex 2 CHAR: 0 pad-left ] { } map-as "" join 16 base> ;
PRIVATE>
: uuid-parse
string>uuid uuid>byte-array ;
: uuid-unparse
byte-array>uuid uuid>string ;
: uuid1
(hardware) (clock) (timestamp) <uuid>
1 (version) uuid>string ;
: uuid3
[ uuid-parse ] dip >byte-array append
md5 checksum-bytes 16 short head byte-array>uuid
3 (version) uuid>string ;
: uuid4
128 random-bits
4 (version) uuid>string ;
: uuid5
[ uuid-parse ] dip >byte-array append
sha1 checksum-bytes 16 short head byte-array>uuid
5 (version) uuid>string ;
: NAMESPACE_DNS "6ba7b810-9dad-11d1-80b4-00c04fd430c8" ; inline
: NAMESPACE_URL "6ba7b811-9dad-11d1-80b4-00c04fd430c8" ; inline
: NAMESPACE_OID "6ba7b812-9dad-11d1-80b4-00c04fd430c8" ; inline
: NAMESPACE_X500 "6ba7b814-9dad-11d1-80b4-00c04fd430c8" ; inline
New Annotation