69 lines
2.2 KiB
Plaintext
69 lines
2.2 KiB
Plaintext
#!/usr/bin/env nomsu -V7.0.0
|
|
###
|
|
A simple UUID function based on RFC 4122: http://www.ietf.org/rfc/rfc4122.txt
|
|
|
|
use "core/metaprogramming"
|
|
use "core/operators"
|
|
use "core/math"
|
|
use "core/collections"
|
|
use "core/control_flow"
|
|
|
|
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
|
|
$NaN_surrogate = {}
|
|
$nil_surrogate = {}
|
|
$obj_by_id = {}
|
|
set $obj_by_id's metatable to {.__mode = "v"}
|
|
$id_by_obj = {}
|
|
set $id_by_obj's metatable to {
|
|
.__mode = "k"
|
|
.__index =
|
|
for ($self $key):
|
|
if ($key == (nil)):
|
|
return $self.$nil_surrogate
|
|
|
|
if ($key != $key):
|
|
return $self.$NaN_surrogate
|
|
|
|
--- (retry) ---
|
|
$id = (uuid)
|
|
if ($obj_by_id.$id != (nil)): go to (retry)
|
|
$self.$key = $id
|
|
$obj_by_id.$id = $key
|
|
return $id
|
|
}
|
|
|
|
external:
|
|
(uuid) means:
|
|
### Set all the other bits to randomly (or pseudo-randomly) chosen values.
|
|
$bytes = [
|
|
### time-low, time-mid, time-high-and-version
|
|
randint (2 ^ (4 * 8)), randint (2 ^ (2 * 8)), randint (2 ^ (2 * 8 - 4))
|
|
|
|
### clock-seq-and-reserved, clock-seq-low
|
|
randint (2 ^ (1 * 8 - 2)), randint (2 ^ (1 * 8)), randint (2 ^ (3 * 8))
|
|
|
|
### node
|
|
randint (2 ^ (3 * 8))
|
|
]
|
|
|
|
### Set the four most significant bits (bits 12 through 15) of the
|
|
### time_hi_and_version field to the 4-bit version number from
|
|
### Section 4.1.3.
|
|
$bytes.3 += 0x4000
|
|
|
|
### Set the two most significant bits (bits 6 and 7) of the
|
|
### clock_seq_hi_and_reserved to zero and one, respectively.
|
|
$bytes.4 += 0xC0
|
|
return (=lua "('%08x-%04x-%04x-%02x%02x-%6x%6x'):format(unpack(\$bytes))")
|
|
|
|
### For strict identity checking, use ($x's id) == ($y's id)
|
|
test:
|
|
assume (([] == []) and ((id of []) != (id of [])))
|
|
seed random with 0
|
|
$x = []
|
|
assume ((id of $x) == (id of $x))
|
|
seed random with 0
|
|
assume ((id of $x) != (id of []))
|
|
seed random
|
|
[id of $, $'s id, $'id] all mean $id_by_obj.$ |