use radix literals

[factor.git] / basis / uuid / uuid.factor

diff --git a/basis/uuid/uuid.factor b/basis/uuid/uuid.factor
index 8b491d7cf2e9309d4113248ebf4c964e35c0e624..3bbc930896b2de58834fd5c52f781bdc35639c20 100644 (file)
--- a/basis/uuid/uuid.factor
+++ b/basis/uuid/uuid.factor
@@ -1,11 +1,9 @@
 ! Copyright (C) 2008 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
-
-USING: byte-arrays checksums checksums.md5 checksums.sha1 
-kernel math math.parser math.ranges random unicode.case 
-sequences strings system ;
-
-IN: uuid 
+USING: byte-arrays calendar checksums checksums.md5
+checksums.sha io.binary kernel math math.parser math.ranges
+random sequences strings system unicode.case ;
+IN: uuid
 
 <PRIVATE
 
@@ -13,15 +11,16 @@ IN: uuid
     ! 0x01b21dd213814000L is the number of 100-ns intervals
     ! between the UUID epoch 1582-10-15 00:00:00 and the 
     ! Unix epoch 1970-01-01 00:00:00.
-    micros 10 * HEX: 01b21dd213814000 +
-    [ -48 shift HEX: 0fff bitand ] 
-    [ -32 shift HEX: ffff bitand ]
-    [ HEX: ffffffff bitand ] tri ;
+    gmt timestamp>micros 10 * 0x01b21dd213814000 +
+    [ -48 shift 0x0fff bitand ] 
+    [ -32 shift 0xffff bitand ]
+    [ 0xffffffff bitand ]
+    tri ;
 
 : (hardware) ( -- address ) 
     ! Choose a random 48-bit number with eighth bit 
     ! set to 1 (as recommended in RFC 4122)
-    48 random-bits HEX: 010000000000 bitor ;
+    48 random-bits 0x010000000000 bitor ;
 
 : (clock) ( -- clockseq ) 
     ! Choose a random 14-bit number
@@ -35,45 +34,37 @@ IN: uuid
     bitor ;
 
 : (version) ( n version -- n' )
-    [ HEX: c000 48 shift bitnot bitand 
-      HEX: 8000 48 shift bitor 
-      HEX: f000 64 shift bitnot bitand
+    [
+        0xc000 48 shift bitnot bitand 
+        0x8000 48 shift bitor 
+        0xf000 64 shift bitnot bitand
     ] dip 76 shift bitor ;
 
 : uuid>string ( n -- string )
-    >hex 32 CHAR: 0 pad-left 
+    >hex 32 CHAR: 0 pad-head 
     [ 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> 15 -1 [a,b) [ 
-        [ dup HEX: ff bitand ] 2dip swap
-        [ set-nth -8 shift ] keep 
-    ] each nip ;
-
-: byte-array>uuid ( byte-array -- n )
-     0 swap [ [ 8 shift ] dip + ] each ;
+    [ CHAR: - = not ] filter hex> ;
 
 PRIVATE>
 
 : uuid-parse ( string -- byte-array ) 
-    string>uuid uuid>byte-array ;
+    string>uuid 16 >be ;
 
 : uuid-unparse ( byte-array -- string ) 
-    byte-array>uuid uuid>string ;
+    be> uuid>string ;
 
 : uuid1 ( -- string )
     (hardware) (clock) (timestamp) <uuid> 
     1 (version) uuid>string ;
 
 : uuid3 ( namespace name -- string )
-    [ uuid-parse ] dip >byte-array append 
-    md5 checksum-bytes 16 short head byte-array>uuid 
+    [ uuid-parse ] dip append 
+    md5 checksum-bytes 16 short head be> 
     3 (version) uuid>string ;
 
 : uuid4 ( -- string )
@@ -81,14 +72,13 @@ PRIVATE>
     4 (version) uuid>string ;
 
 : uuid5 ( namespace name -- string )
-   [ uuid-parse ] dip >byte-array append 
-    sha1 checksum-bytes 16 short head byte-array>uuid 
+    [ uuid-parse ] dip append 
+    sha1 checksum-bytes 16 short head be> 
     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
+CONSTANT: NAMESPACE_DNS  "6ba7b810-9dad-11d1-80b4-00c04fd430c8"
+CONSTANT: NAMESPACE_URL  "6ba7b811-9dad-11d1-80b4-00c04fd430c8"
+CONSTANT: NAMESPACE_OID  "6ba7b812-9dad-11d1-80b4-00c04fd430c8"
+CONSTANT: NAMESPACE_X500 "6ba7b814-9dad-11d1-80b4-00c04fd430c8"