code / nomsu

   1 #!/usr/bin/env nomsu -V7.0.0
   2 ###
   3     A simple UUID function based on RFC 4122: http://www.ietf.org/rfc/rfc4122.txt
   4     
   5 use "core/metaprogramming"
   6 use "core/operators"
   7 use "core/math"
   8 use "core/collections"
   9 use "core/control_flow"
  10 
  11 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  12 
  13 $NaN_surrogate = {}
  14 $nil_surrogate = {}
  15 $obj_by_id = {}
  16 set $obj_by_id's metatable to {.__mode = "v"}
  17 $id_by_obj = {}
  18 set $id_by_obj's metatable to {
  19     .__mode = "k"
  20     .__index =
  21         for ($self $key):
  22             if ($key == (nil)):
  23                 return $self.$nil_surrogate
  24             
  25             if ($key != $key):
  26                 return $self.$NaN_surrogate
  27             
  28             --- (retry) ---
  29             $id = (uuid)
  30             if ($obj_by_id.$id != (nil)): go to (retry)
  31             $self.$key = $id
  32             $obj_by_id.$id = $key
  33             return $id
  34 }
  35 
  36 external:
  37     (uuid) means:
  38         ### Set all the other bits to randomly (or pseudo-randomly) chosen values.
  39         $bytes = [
  40             ### time-low, time-mid, time-high-and-version
  41             randint (2 ^ (4 * 8)), randint (2 ^ (2 * 8)), randint (2 ^ (2 * 8 - 4))
  42             
  43             ### clock-seq-and-reserved, clock-seq-low
  44             randint (2 ^ (1 * 8 - 2)), randint (2 ^ (1 * 8)), randint (2 ^ (3 * 8))
  45             
  46             ### node
  47             randint (2 ^ (3 * 8))
  48         ]
  49         
  50         ### Set the four most significant bits (bits 12 through 15) of the
  51         ### time_hi_and_version field to the 4-bit version number from
  52         ### Section 4.1.3.
  53         $bytes.3 += 0x4000
  54         
  55         ### Set the two most significant bits (bits 6 and 7) of the
  56         ### clock_seq_hi_and_reserved to zero and one, respectively.
  57         $bytes.4 += 0xC0
  58         return (=lua "('%08x-%04x-%04x-%02x%02x-%6x%6x'):format(unpack(\$bytes))")
  59     
  60     ### For strict identity checking, use ($x's id) == ($y's id)
  61     test:
  62         assume (([] == []) and ((id of []) != (id of [])))
  63         seed random with 0
  64         $x = []
  65         assume ((id of $x) == (id of $x))
  66         seed random with 0
  67         assume ((id of $x) != (id of []))
  68         seed random
  69     [id of $, $'s id, $'id] all mean $id_by_obj.$