blob: 61ffeaad1974c4a83f004ee466ed1b141d9072ea (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
#!/usr/bin/env nomsu -V6.14
#
A simple UUID function based on RFC 4122: http://www.ietf.org/rfc/rfc4122.txt
use "core/metaprogramming.nom"
use "core/operators.nom"
use "core/math.nom"
use "core/collections.nom"
use "core/control_flow.nom"
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
$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
}
externally (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
externally [id of $, $'s id, $'id] all mean $id_by_obj.$
|
