aboutsummaryrefslogtreecommitdiff
path: root/lib/core/id.nom
diff options
context:
space:
mode:
authorBruce Hill <bruce@bruce-hill.com>2019-01-14 15:42:48 -0800
committerBruce Hill <bruce@bruce-hill.com>2019-01-14 15:43:24 -0800
commitc1c32688a4afc43f6addb99b8b5fa878944a70e3 (patch)
treec886f21b5b08a9053aa74fcba4b241dae5ede76d /lib/core/id.nom
parent2309b696fc34b24f05f6658b94f9105ca8ee76e4 (diff)
Overhaul in progress, mostly working. Moved all the nomsu packages into
lib/, including core/*. Changes to how nomsu environments and importing work.
Diffstat (limited to 'lib/core/id.nom')
-rw-r--r--lib/core/id.nom66
1 files changed, 66 insertions, 0 deletions
diff --git a/lib/core/id.nom b/lib/core/id.nom
new file mode 100644
index 0000000..d2427b5
--- /dev/null
+++ b/lib/core/id.nom
@@ -0,0 +1,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"
+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
+}
+
+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.$