diff --git a/basis/uuid/uuid-docs.factor b/basis/uuid/uuid-docs.factor index 0408da85b8..487d5a1104 100644 --- a/basis/uuid/uuid-docs.factor +++ b/basis/uuid/uuid-docs.factor @@ -4,23 +4,27 @@ USING: help.syntax help.markup kernel prettyprint sequences strings ; IN: uuid HELP: uuid1 +{ $values { "string" "a UUID string" } } { $description "Generates a UUID (version 1) from the host ID, sequence number, " "and current time." } ; HELP: uuid3 +{ $values { "namespace" string } { "name" string } { "string" "a UUID string" } } { $description "Generates a UUID (version 3) from the MD5 hash of a namespace " "UUID and a name." } ; HELP: uuid4 +{ $values { "string" "a UUID string" } } { $description "Generates a UUID (version 4) from random bits." } ; HELP: uuid5 +{ $values { "namespace" string } { "name" string } { "string" "a UUID string" } } { $description "Generates a UUID (version 5) from the SHA-1 hash of a namespace " "UUID and a name." @@ -28,12 +32,10 @@ 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" +"The " { $vocab-link "uuid" } " vocabulary is used to generate UUIDs. " +"The below words can be used to generate version 1, 3, 4, and 5 UUIDs as specified in RFC 4122." +$nl +"If all you want is a unique ID, you should probably call " { $link uuid1 } " or " { $link uuid4 } "." { $subsection uuid1 } { $subsection uuid3 } { $subsection uuid4 } diff --git a/basis/uuid/uuid.factor b/basis/uuid/uuid.factor index 8b491d7cf2..337ea22df5 100644 --- a/basis/uuid/uuid.factor +++ b/basis/uuid/uuid.factor @@ -3,7 +3,7 @@ USING: byte-arrays checksums checksums.md5 checksums.sha1 kernel math math.parser math.ranges random unicode.case -sequences strings system ; +sequences strings system io.binary ; IN: uuid @@ -16,7 +16,8 @@ IN: uuid micros 10 * HEX: 01b21dd213814000 + [ -48 shift HEX: 0fff bitand ] [ -32 shift HEX: ffff bitand ] - [ HEX: ffffffff bitand ] tri ; + [ HEX: ffffffff bitand ] + tri ; : (hardware) ( -- address ) ! Choose a random 48-bit number with eighth bit @@ -35,9 +36,10 @@ IN: uuid bitor ; : (version) ( n version -- n' ) - [ HEX: c000 48 shift bitnot bitand - HEX: 8000 48 shift bitor - HEX: f000 64 shift bitnot bitand + [ + HEX: c000 48 shift bitnot bitand + HEX: 8000 48 shift bitor + HEX: f000 64 shift bitnot bitand ] dip 76 shift bitor ; : uuid>string ( n -- string ) @@ -51,13 +53,7 @@ IN: uuid [ CHAR: - = not ] filter 16 base> ; : uuid>byte-array ( n -- byte-array ) - 16 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 ; + 16 >be ; PRIVATE> @@ -65,15 +61,15 @@ PRIVATE> string>uuid uuid>byte-array ; : uuid-unparse ( byte-array -- string ) - byte-array>uuid uuid>string ; + be> uuid>string ; : uuid1 ( -- string ) (hardware) (clock) (timestamp) 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 +77,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"