Updating uuid module.

extra/uuid/uuid-docs.factor

@@ -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"
+
+

extra/uuid/uuid-tests.factor

@@ -1,11 +1,18 @@
 ! Copyright (C) 2008 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
 
-USING: kernel uuid uuid.private tools.test ;
+USING: kernel uuid tools.test ;
 
 IN: uuid.tests
 
-[ t ] [ NAMESPACE_URL [ string>uuid uuid>string ] keep = ] unit-test
-[ t ] [ NAMESPACE_URL string>uuid [ uuid>byte-array byte-array>uuid ] keep = ] unit-test
+[ t ] [ NAMESPACE_DNS  [ uuid-parse uuid-unparse ] 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
 

extra/uuid/uuid.factor

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