steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Updating uuid module.

db4
John Benediktsson 2008-12-20 18:38:35 -08:00
parent 43e12f15e9
commit 83d8d50546
3 changed files with 39 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
extra/uuid/uuid-docs.factor
View File

@ -27,3 +27,19 @@ HELP: uuid5
} ; } ;
ARTICLE: "uuid" "UUID (Universally Unique Identifier)"
"The " { $vocab-link "uuid" } " vocabulary is used to generate UUID's. "
"The words uuid1, uuid3, uuid4, uuid5 can be used to generate version "
"1, 3, 4, and 5 UUIDs as specified in RFC 4122.\n"
"\n"
"If all you want is a unique ID, you should probably call uuid1 or uuid4."
"\n"
{ $subsection uuid1 }
{ $subsection uuid3 }
{ $subsection uuid4 }
{ $subsection uuid5 }
;
ABOUT: "uuid"

13
extra/uuid/uuid-tests.factor
View File

@ -1,11 +1,18 @@
! Copyright (C) 2008 John Benediktsson ! Copyright (C) 2008 John Benediktsson
! See http://factorcode.org/license.txt for BSD license ! See http://factorcode.org/license.txt for BSD license
USING: kernel uuid uuid.private tools.test ; USING: kernel uuid tools.test ;
IN: uuid.tests IN: uuid.tests
[ t ] [ NAMESPACE_URL [ string>uuid uuid>string ] keep = ] unit-test [ t ] [ NAMESPACE_DNS [ uuid-parse uuid-unparse ] keep = ] unit-test
[ t ] [ NAMESPACE_URL string>uuid [ uuid>byte-array byte-array>uuid ] keep = ] unit-test [ t ] [ NAMESPACE_URL [ uuid-parse uuid-unparse ] keep = ] unit-test
[ t ] [ NAMESPACE_OID [ uuid-parse uuid-unparse ] keep = ] unit-test
[ t ] [ NAMESPACE_X500 [ uuid-parse uuid-unparse ] keep = ] unit-test
[ t ] [ NAMESPACE_URL "ABCD" uuid3
"2e10e403-d7fa-3ffb-808f-ab834a46890e" = ] unit-test
[ t ] [ NAMESPACE_URL "ABCD" uuid5
"0aa883d6-7953-57e7-a8f0-66db29ce5a91" = ] unit-test

24
extra/uuid/uuid.factor
View File

@ -1,9 +1,8 @@
! Copyright (C) 2008 John Benediktsson ! Copyright (C) 2008 John Benediktsson
! See http://factorcode.org/license.txt for BSD license ! See http://factorcode.org/license.txt for BSD license
USING: alien.syntax alien.c-types byte-arrays USING: byte-arrays checksums checksums.md5 checksums.sha1
checksums checksums.md5 checksums.sha1 kernel kernel math math.parser math.ranges random unicode.case
math math.parser math.ranges random unicode.case
sequences strings system ; sequences strings system ;
IN: uuid IN: uuid
@ -43,23 +42,22 @@ IN: uuid
: uuid>string ( n -- string ) : uuid>string ( n -- string )
>hex 32 CHAR: 0 pad-left >hex 32 CHAR: 0 pad-left
CHAR: - 20 rot insert-nth [ CHAR: - 20 ] dip insert-nth
CHAR: - 16 rot insert-nth [ CHAR: - 16 ] dip insert-nth
CHAR: - 12 rot insert-nth [ CHAR: - 12 ] dip insert-nth
CHAR: - 8 rot insert-nth ; [ CHAR: - 8 ] dip insert-nth ;
: string>uuid ( string -- n ) : string>uuid ( string -- n )
[ CHAR: - = not ] filter 16 base> ; [ CHAR: - = not ] filter 16 base> ;
: uuid>byte-array ( n -- byte-array ) : uuid>byte-array ( n -- byte-array )
16 <byte-array> swap 0 15 1 <range> 16 <byte-array> swap 15 -1 [a,b) [
[ dup 8 * neg [ swap dup ] dip rot [ dup HEX: ff bitand ] 2dip
shift HEX: ff bitand rot roll [ set-nth ] keep swap -8 shift
[ set-nth ] keep swap ] each drop ;
] each drop reverse ;
: byte-array>uuid ( byte-array -- n ) : byte-array>uuid ( byte-array -- n )
[ >hex 2 CHAR: 0 pad-left ] { } map-as "" join 16 base> ; 0 swap [ [ 8 shift ] dip + ] each ;
PRIVATE> PRIVATE>