/* std.pk - Standard definitions for poke.  */

/* Copyright (C) 2019, 2020, 2021, 2022, 2023, 2024 Jose E. Marchesi.  */

/* This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
 */

/* Please do not use any standard type in this file.  They may not
   have been defined.  */

/*** Standard units.  */

unit b = 1;
unit N = 4;
unit B = 8;

unit Kb = 10UL ** 3;
unit KB = 10UL ** 3 * 8;
unit Mb = 10UL ** 6;
unit MB = 10UL ** 6 * 8;
unit Gb = 10UL ** 9;
unit GB = 10UL ** 9 * 8;

unit Kib = 2UL ** 10;
unit KiB = 2UL ** 10 * 8;
unit Mib = 2UL ** 20;
unit MiB = 2UL ** 20 * 8;
unit Gib = 2UL ** 30;
unit GiB = 2UL ** 30 * 8;

/*** Colors.  */

var term_default_color = [-1,-1,-1];
var term_default_bgcolor = [-1,-1,-1];

/*** Conversion Functions.  */

fun catos = (uint<8>[] chars) string:
  {
   var s = "";

   for (c in chars)
     {
       if (c == '\0')
         return s;
       s = s + c as string;
     }
   return s;
  }

fun stoca = (string s, uint<8>[] ca = uint<8>[](), uint<8> fill = 0) uint<8>[]:
  {
    if (ca'length == 0)
      {
        var ret = uint<8>[s'length]();
        for (var i = 0; i < s'length; i++)
          ret[i] = s[i];
        return ret;
      }

    if (s'length > ca'length)
      raise E_out_of_bounds;

    var i = 0;
    while (i < ca'length)
      {
        ca[i] = i < s'length ? s[i] : fill;
        i = i + 1;
      }

    return ca;
  }

type Strtoi_Result =
  struct
  {
    uint<64> off;
    int<64> val;
  };

fun strtoi = (string s, int<32> b = 10, uint<64> start = 0) Strtoi_Result:
  {
    var result = 0L;

    if (start >= s'length)
      raise E_out_of_bounds;

    fun htoi = (uint<8> c) int<32>:
      {
        if (c >= '0' && c <= '9') return c - '0';
        if (c >= 'a' && c <= 'f') return c - 'a' + 10;
        if (c >= 'A' && c <= 'F') return c - 'A' + 10;
      }

    fun valid = (uint<8> c, int<32> b) int<32>:
      {
        if (b <= 10) return (c >= '0') && (c <= '0' + b - 1);
        if (b == 16) return ((c >= '0') && (c <= '9')) ||
         ((c >= 'a') && (c <= 'f')) || ((c >= 'A') && (c <= 'F'));
      }

    fun signchar = (string str) int<8>:
      {
        if (str'length > 1) return str[0];
        return 0;
      }

    fun signum = (uint<8> c) int<32>:
      {
        if (c == '-') return -1;
        if (c == '+') return +1;
        return 0;
      }

    if (!(b in [2, 8, 10, 16]))
      raise E_inval;

    var sign = signum (signchar (s));
    if (sign == 0)
      sign = +1;
    else
      s = s[1:];

    var i = start;
    for (; i < s'length; i++)
    {
      var c = s[i];
      if (!valid(c, b))
        break;

      result = result * b + htoi (c);
    }

    return Strtoi_Result { val = sign * result, off = i };
  }

fun atoi = (string s, int<32> b = 10) int<64>:
{
  /* Match old behavior.  */
  if (s == "")
    return 0;
  return strtoi (s, b).val;
}

fun ltos = (int<64> i, uint<32> base = 10) string:
{
  var chars = "0123456789abcdef";
  var s = "";
  var o = i;

  if (base > 16)
    raise E_inval;

  if (i < 0)
    i = -i;
  if (i == 0)
    return "0";
  while (i > 0)
  {
    s = chars[i % base] as string + s;
    i = i / base;
  }

  if (o < 0)
    s = "-" + s;

  return s;
}

/*** Array functions.  */

/* Reverse the given array.  */

fun reverse = (any[] a) void:
{
  if (a'length == 0)
    return;

  var l = 0;
  var h = a'length - 1;

  while (h > l)
  {
    var tmp = a[l];
    a[l++] = a[h];
    a[h--] = tmp;
  }
}

/*** String functions.  */

/* Return the index in the string S of the first occurrence of the
   character C.  If C is not in S then return the size of S.  */

fun strchr = (string s, uint<8> c) int<32>:
  {
    var i = 0;
    for (t in s)
      {
        if (s[i] == c)
          break;
        i = i + 1;
      }

    return i;
  }

/* Return the index in the string S of the last occurrence of the
   character C.  If C is not in S then return -1.  */

fun strrchr = (string s, uint<8> c) int<32>:
  {
    if (s'length == 0)
      return -1;

    var i = (s'length - 1) as int<32>;
    while (i >= 0)
      {
        if (s[i] == c)
          break;
        i--;
      }
    return i;
  }

/* Return the index in the string HAYSTACK of the first occurrence of
   the string NEEDLE.  If NEEDLE is not in HAYSTACK then return the
   size of S.  */

fun strstr = (string haystack, string needle) int<32>:
  {
    var i = 0UL;
    var haystack_len = haystack'length;
    var needle_len = needle'length;

    for (; i < haystack_len; ++i)
      if (haystack[i:]'length >= needle_len
          && haystack[i+:needle_len] == needle)
        break;

    return i;
  }

/* Return S with leading characters belonging to the given set
   omitted.  By default the omitted characters are whitespaces.  */

fun ltrim = (string s, string cs = " \t") string:
  {
    var cs_length = cs'length;
    var result = "";
    for (c in s)
      {
	if (strchr (cs, c) == cs_length || result != "")
	  result = result + c as string;
      }
    return result;
  }

/* Return S with trailing character belonging tot he given set
   omitted.  By default the omitted characters are whitespaces.  */

fun rtrim = (string s, string cs = " \t") string:
  {
    var cs_length = cs'length;
    var result = "";
    var i = s'length;
    while (i > 0)
    {
      var c = s[i - 1];
      if (strchr (cs, c) == cs_length || result != "")
        result = c as string + result;
      i = i - 1;
    }
    return result;
  }

/*** Sorting Functions.  */

type Comparator = (any,any)int<32>;

fun qsort = (any[] array, Comparator cmp_f,
               int<64> left = 0, int<64> right = array'length - 1) void:
{
   fun partition = int<32>:
   {
     fun swap = (int<64> i1, int<64> i2) void:
     {
       var t = array[i1];
       array[i1] = array[i2];
       array[i2] = t;
     }

     var pivot = array[right];
     var i = left - 1;

     var j = left;
     while (j <= right - 1)
     {
       if (cmp_f (array[j], pivot) <= 0)
       {
         i = i + 1;
         swap (i, j);
       }

       j = j + 1;
     }

     swap (i + 1, right);
     return i + 1;
   }

   if (left < right)
   {
     var pi = partition;

     qsort (array, cmp_f, left, pi - 1);
     qsort (array, cmp_f, pi + 1, right);
   }
}

/*** CRC functions.  */

/*
   See ISO 3309 [ISO-3309] or ITU-T V.42 [ITU-V42] for a formal specification.
*/

fun crc32 = (uint<8>[] buf) uint<32>:
  {
   fun update = (uint<32> crc, uint<8>[] buf) uint<32>:
   {
    var table =
    [
      0x00000000U, 0x77073096U, 0xee0e612cU, 0x990951baU, 0x076dc419U,
      0x706af48fU, 0xe963a535U, 0x9e6495a3U, 0x0edb8832U, 0x79dcb8a4U,
      0xe0d5e91eU, 0x97d2d988U, 0x09b64c2bU, 0x7eb17cbdU, 0xe7b82d07U,
      0x90bf1d91U, 0x1db71064U, 0x6ab020f2U, 0xf3b97148U, 0x84be41deU,
      0x1adad47dU, 0x6ddde4ebU, 0xf4d4b551U, 0x83d385c7U, 0x136c9856U,
      0x646ba8c0U, 0xfd62f97aU, 0x8a65c9ecU, 0x14015c4fU, 0x63066cd9U,
      0xfa0f3d63U, 0x8d080df5U, 0x3b6e20c8U, 0x4c69105eU, 0xd56041e4U,
      0xa2677172U, 0x3c03e4d1U, 0x4b04d447U, 0xd20d85fdU, 0xa50ab56bU,
      0x35b5a8faU, 0x42b2986cU, 0xdbbbc9d6U, 0xacbcf940U, 0x32d86ce3U,
      0x45df5c75U, 0xdcd60dcfU, 0xabd13d59U, 0x26d930acU, 0x51de003aU,
      0xc8d75180U, 0xbfd06116U, 0x21b4f4b5U, 0x56b3c423U, 0xcfba9599U,
      0xb8bda50fU, 0x2802b89eU, 0x5f058808U, 0xc60cd9b2U, 0xb10be924U,
      0x2f6f7c87U, 0x58684c11U, 0xc1611dabU, 0xb6662d3dU, 0x76dc4190U,
      0x01db7106U, 0x98d220bcU, 0xefd5102aU, 0x71b18589U, 0x06b6b51fU,
      0x9fbfe4a5U, 0xe8b8d433U, 0x7807c9a2U, 0x0f00f934U, 0x9609a88eU,
      0xe10e9818U, 0x7f6a0dbbU, 0x086d3d2dU, 0x91646c97U, 0xe6635c01U,
      0x6b6b51f4U, 0x1c6c6162U, 0x856530d8U, 0xf262004eU, 0x6c0695edU,
      0x1b01a57bU, 0x8208f4c1U, 0xf50fc457U, 0x65b0d9c6U, 0x12b7e950U,
      0x8bbeb8eaU, 0xfcb9887cU, 0x62dd1ddfU, 0x15da2d49U, 0x8cd37cf3U,
      0xfbd44c65U, 0x4db26158U, 0x3ab551ceU, 0xa3bc0074U, 0xd4bb30e2U,
      0x4adfa541U, 0x3dd895d7U, 0xa4d1c46dU, 0xd3d6f4fbU, 0x4369e96aU,
      0x346ed9fcU, 0xad678846U, 0xda60b8d0U, 0x44042d73U, 0x33031de5U,
      0xaa0a4c5fU, 0xdd0d7cc9U, 0x5005713cU, 0x270241aaU, 0xbe0b1010U,
      0xc90c2086U, 0x5768b525U, 0x206f85b3U, 0xb966d409U, 0xce61e49fU,
      0x5edef90eU, 0x29d9c998U, 0xb0d09822U, 0xc7d7a8b4U, 0x59b33d17U,
      0x2eb40d81U, 0xb7bd5c3bU, 0xc0ba6cadU, 0xedb88320U, 0x9abfb3b6U,
      0x03b6e20cU, 0x74b1d29aU, 0xead54739U, 0x9dd277afU, 0x04db2615U,
      0x73dc1683U, 0xe3630b12U, 0x94643b84U, 0x0d6d6a3eU, 0x7a6a5aa8U,
      0xe40ecf0bU, 0x9309ff9dU, 0x0a00ae27U, 0x7d079eb1U, 0xf00f9344U,
      0x8708a3d2U, 0x1e01f268U, 0x6906c2feU, 0xf762575dU, 0x806567cbU,
      0x196c3671U, 0x6e6b06e7U, 0xfed41b76U, 0x89d32be0U, 0x10da7a5aU,
      0x67dd4accU, 0xf9b9df6fU, 0x8ebeeff9U, 0x17b7be43U, 0x60b08ed5U,
      0xd6d6a3e8U, 0xa1d1937eU, 0x38d8c2c4U, 0x4fdff252U, 0xd1bb67f1U,
      0xa6bc5767U, 0x3fb506ddU, 0x48b2364bU, 0xd80d2bdaU, 0xaf0a1b4cU,
      0x36034af6U, 0x41047a60U, 0xdf60efc3U, 0xa867df55U, 0x316e8eefU,
      0x4669be79U, 0xcb61b38cU, 0xbc66831aU, 0x256fd2a0U, 0x5268e236U,
      0xcc0c7795U, 0xbb0b4703U, 0x220216b9U, 0x5505262fU, 0xc5ba3bbeU,
      0xb2bd0b28U, 0x2bb45a92U, 0x5cb36a04U, 0xc2d7ffa7U, 0xb5d0cf31U,
      0x2cd99e8bU, 0x5bdeae1dU, 0x9b64c2b0U, 0xec63f226U, 0x756aa39cU,
      0x026d930aU, 0x9c0906a9U, 0xeb0e363fU, 0x72076785U, 0x05005713U,
      0x95bf4a82U, 0xe2b87a14U, 0x7bb12baeU, 0x0cb61b38U, 0x92d28e9bU,
      0xe5d5be0dU, 0x7cdcefb7U, 0x0bdbdf21U, 0x86d3d2d4U, 0xf1d4e242U,
      0x68ddb3f8U, 0x1fda836eU, 0x81be16cdU, 0xf6b9265bU, 0x6fb077e1U,
      0x18b74777U, 0x88085ae6U, 0xff0f6a70U, 0x66063bcaU, 0x11010b5cU,
      0x8f659effU, 0xf862ae69U, 0x616bffd3U, 0x166ccf45U, 0xa00ae278U,
      0xd70dd2eeU, 0x4e048354U, 0x3903b3c2U, 0xa7672661U, 0xd06016f7U,
      0x4969474dU, 0x3e6e77dbU, 0xaed16a4aU, 0xd9d65adcU, 0x40df0b66U,
      0x37d83bf0U, 0xa9bcae53U, 0xdebb9ec5U, 0x47b2cf7fU, 0x30b5ffe9U,
      0xbdbdf21cU, 0xcabac28aU, 0x53b39330U, 0x24b4a3a6U, 0xbad03605U,
      0xcdd70693U, 0x54de5729U, 0x23d967bfU, 0xb3667a2eU, 0xc4614ab8U,
      0x5d681b02U, 0x2a6f2b94U, 0xb40bbe37U, 0xc30c8ea1U, 0x5a05df1bU,
      0x2d02ef8dU
    ];

    var c = crc as uint<32>;
    for (x in buf)
      {
	c = table[(c ^ x) & 0xff] ^ (c .>> 8);
      }
    return c;
   }

   return update (0xffffffffU, buf) ^ 0xffffffffU;
  }

/*** IOS related.  */

fun openset = (string handler, uint<64> flags = 0) int<32>:
{
  var ios = open (handler, flags);

  set_ios (ios);
  return ios;
}

fun opensub = (int<32> ios,
               offset<uint<64>,B> base, offset<uint<64>,B> size,
               string name = "",
               uint<64> flags = 0) int<32>:
{
  var handler = ("sub://"
                 + ltos (ios) + "/"
                 + "0x" + ltos (base/#B, 16) + "/"
                 + "0x" + ltos (size/#B, 16) + "/"
                 + name);

  return open (handler, flags);
}

fun openproc = (uint<64> pid, uint<64> flags = 0) int<32>:
{
  return open (format ("pid://%u64d", pid), flags);
}

fun openmmap = (string path,
                offset<uint<64>,B> base,
                offset<uint<64>,B> size) int<32>:
{
  return open (format ("mmap://%u64d/%u64d/%s", base/#B, size/#B, path));
}

/*** Miscellanea.  */

var NULL = 0#B;

/* Align the given offset to the given alignment.  */

fun alignto = (offset<uint<64>,b> offset,
               offset<uint<64>,b> to) offset<uint<64>,b>:
  {
    return (to - (offset % to)) % to;
  }

/* Exit a Poke program with the given exit status code.  This is equivalent
   to raise an E_exit exception, but provides a more conventional
   syntax.  */

fun exit = (int<32> exit_code = 0) void:
  {
    raise Exception { code = EC_exit, name = "exit", exit_status = exit_code };
  }

/* Return the offset of the element having the given name in the given
   composite value.

   If the value doesn't contain an element with the given name then
   raise E_inval.  */

fun eoffset = (any v, string n) offset<uint<64>,b>:
  {
    for (var i = 0UL; i < v'length; ++i)
      if (n == v'ename (i))
        return v'eoffset (i);
    raise E_inval;
  }

/* Generator of uniquely-named memory IO handlers.  */

type Pk_Temp_Ios_Generator = ()string;

var pk_get_unique_mem_ios_handler = lambda Pk_Temp_Ios_Generator:
{
  var n = 0;
  return lambda string: { return format ("*tmp%u32d*", n++); };
} ();

/* Open a temporary IO space, set it as current, and execute a given
   function.

   HANDLER is the handler to use for the IO space.

   FLAGS are the flags passed to `open' when opening the temporary IO
   space.  Defaults to 0, which means to use whatever opening mode
   makes more sense depending on the kind of the IO space and it's
   permissions.

   DO is a function of type ()void.  Defaults to a function that does
   nothing.

   ENDIAN is the endianness to use by default when accessing the
   temporary IO space.  Defaults to the current endianness.

   Note that once `with_temp_ios' finishes executing, either by
   returning or by the raise of an exception, the temporary IO space
   is closed and the original current endianness is restored.  */

type Pk_With_Ios_Fn = ()void;

fun with_temp_ios = (string handler = pk_get_unique_mem_ios_handler,
                     uint<32> flags = 0,
                     Pk_With_Ios_Fn do = lambda void:{},
                     int<32> endian = get_endian) void:
{
  var old_ios = get_ios ?! E_no_ios ? -1 : get_ios;
  var old_endian = get_endian;
  var new_ios = open (handler, flags);

  set_ios (new_ios);
  set_endian (endian);
  try
  {
    do ();
    close (new_ios);
    set_endian (old_endian);
    if (-1 != old_ios)
      set_ios (old_ios);
  }
  catch (Exception exc)
  {
    close (new_ios);
    set_endian (old_endian);
    if (-1 != old_ios)
      set_ios (old_ios);
    raise exc;
  }
}

/* Set a given IO space as current and execute a given function.  Once
   the function finishes executing, either by returning or by the
   raise of an exception, the current IO space and endianness are
   restored to their previous values.  */

fun with_cur_ios = (int<32> ios,
                    Pk_With_Ios_Fn do = lambda void:{},
                    int<32> endian = get_endian) void:
{
  var old_ios = get_ios ?! E_no_ios ? -1 : get_ios;
  var old_endian = get_endian;

  set_ios (ios);
  set_endian (endian);
  try
  {
    do ();
    set_endian (old_endian);
    if (-1 != old_ios)
      set_ios (old_ios);
  }
  catch (Exception exc)
  {
    set_endian (old_endian);
    if (-1 != old_ios)
      set_ios (old_ios);
    raise exc;
  }
}

/* Determine that the given ASCII character is a decimal digit or not.  */

fun isdigit = (uint<8> c) int<32>:
{
  return c - '0' < 10;
}

/* Determine that the given ASCII character is a hexadecimal digit or not.  */

fun isxdigit = (uint<8> c) int<32>:
{
  return (c - '0' < 10UB) || ((c | 0x20UB) - 'a' < 6UB);
}

/* A helper object to tokenize a string.  */

type String_Tokenizer =
  struct
  {
    uint<64> i;
    string str;
    computed uint<32> more;

    method raise_exception = (Exception base, string message) void:
    {
      raise Exception {
        code = base.code,
        name = base.name,
        exit_status = base.exit_status,
        location = "at position " + ltos (i),
        msg = message
      };
    }

    method get_more = uint<32>:
    {
      return i < str'length;
    }

    method peek = uint<8>:
    {
      if (!get_more ())
        raise E_out_of_bounds;

      return str[i];
    }

    method pop = uint<8>:
    {
      if (!get_more ())
        raise E_out_of_bounds;
      return str[i++];
    }

    method pop_number = (int<32> base = 10) int<64>:
    {
      if (!get_more ())
        raise E_out_of_bounds;

      var res = strtoi (str, base, i);
      if (res.off == i)
        raise_exception (E_inval, "expected number");

      i = res.off;
      return res.val;
    }

    method popdelim = (string delimiters) string:
    {
      /* TODO(arsen): Replace with some set-based thing at some point.  */
      if (delimiters'length == 0)
        raise E_inval;

      if (!get_more ())
        raise E_out_of_bounds;

      var j = i;
      for (; j < str'length; j++)
        {
          var c = str[j];
          for (d in delimiters)
            {
              if (c != d)
                continue;

              var s = str[i:j];
              i = j + 1;
              return s;
            }
        }
      var s = str[i:];
      i = str'length;
      return s;
    }

    method poprdelim = (string delimiters) string:
    {
      /* TODO(arsen): Replace with some set-based thing at some point.  */
      if (delimiters'length == 0)
        raise E_inval;

      if (!get_more ())
        raise E_out_of_bounds;

      var j = str'length - 1;
      for (; j >= i && j < str'length; j--)
        {
          var c = str[j];
          for (d in delimiters)
            {
              if (c != d)
                continue;

              var s = str[i:j];
              i = j + 1;
              return s;
            }
        }
      var s = str[i:];
      i = str'length;
      return s;
    }
  };

fun strtok = (string a) String_Tokenizer:
{
  return String_Tokenizer { str = a, i = 0 };
}

/* Structured representation of GNU poke version strings.  */

type Pk_Version =
  struct
  {
    uint<8> major;
    uint<8> minor;
    uint<8> subminor;
    string branch;
    uint<32> offset;
    string commit;

    uint<8> has_branch_p;
    uint<8> has_subminor_p;
    uint<8> has_commit_p;
    uint<8> dirty_p;

    method to_string = string:
    {
      return format ("%u8d.%u8d%s%s%s%s%s",
                     major, minor,
                     has_subminor_p ? format (".%u8d", subminor) : "",
                     has_branch_p ? "-" + branch : "",
                     has_branch_p ? format ("-%u32d", offset) : "",
                     has_commit_p ? "-g" + commit : "",
                     dirty_p ? "-dirty" : "");
    }

    method _print = void:
    {
      printf "#<%s>", to_string;
    }
  };

/* Parse the string A into a new Pk_Version object.  */

fun pk_version_parse = (string a) Pk_Version:
{
  var res = Pk_Version {};

  /* Strip the -dirty suffix, if any.  */
  var dirty = "-dirty";
  if (a'length >= dirty'length)
    {
      var i = a'length - dirty'length;
      if (a[i:] == dirty)
        {
          a = a[:i];
          res.dirty_p = 1;
        };
    }

  /* With -dirty removed, we can be left with -g[[:xdigit:]]*.  We expect at
     least a couple letters after a -g, so lets go with a safe three (+ 1 for
     the ``g'').  Note that git-version-gen sets --abbrev=4 right now.  */
  var dashi = strrchr (a, '-');
  if (dashi != -1 && dashi + 4 < a'length && a[dashi + 1] == 'g')
    {
      var has_hash = 1;
      for (var i = dashi + 2;
           i < a'length;
           i++)
        {
          if (isxdigit (a[i]))
            continue;
          has_hash = 0;
          break;
        };
      res.has_commit_p = 1;
      res.commit = a[dashi + 2:];
      if (has_hash)
        a = a[:dashi];
    };

  var i = strtok (a);

  if (!i.more)
    i.raise_exception (E_inval, "expected major.minor");

  /* Helper that pops an equal character from the tokenizer, and checks that
     it's the desired character.  */
  fun popassert = (uint<8> x) void:
  {
    try
      {
        if (i.peek () != x)
          i.raise_exception (E_inval, "expected '" + x as string + "'");
        i.i++;
      }
    catch if E_out_of_bounds
      {
        i.raise_exception (E_inval, "expected '" + x as string + "', got EOF");
      }
  };

  try
    {
      /* Parsing over x.y[.z][-STR-n].  We expect a number, period, and number,
         possibly followed by two one more component, a branch identifier and the
         number of commits on said branch.  */
      res.major = i.pop_number ();
      /* Mandatory period.  */
      popassert ('.');
      res.minor = i.pop_number();
    }
  catch if E_out_of_bounds
    {
      /* If any of these two are missing, it's an invalid.  */
      i.raise_exception (E_inval, "missing mandatory component");
    };

  if (!i.more)
    return res;

  if (i.peek () == '.')
    {
      i.i++;
      res.has_subminor_p =1;
      res.subminor = i.pop_number();
    };

  if (!i.more)
    return res;

  try
    {
      popassert ('-');
      res.has_branch_p = 1;
      res.branch = i.poprdelim ("-");
      /* The above should've popped the dash too.  */
      res.offset = i.pop_number ();
    }
  catch if E_out_of_bounds
    {
      /* If any of these two are missing, it's an invalid.  */
      i.raise_exception (E_inval, "branch-offset component incomplete");
    };

  /* We shouldn't have trailing data at this point, beyond the -gXDIGIT string,
     or the -dirty string, but both should be stripped already.  */
  if (i.more)
    i.raise_exception (E_inval, "trailing data");

  return res;
};

/* Compare a pair GNU poke version strings.  */

fun pk_vercmp = (any _a, any _b) int<32>:
{
  fun shoehorn = (any x) Pk_Version:
  {
    if (x isa Pk_Version)
      return x as Pk_Version;
    if (x isa string)
      return pk_version_parse (x as string);
    raise E_conv;
  };

  var a = shoehorn (_a);
  var b = shoehorn (_b);

  fun cmp = (uint<32> a, uint<32> b) int<32>:
  {
    if (a > b)
      return 1;
    if (a < b)
      return -1;
    return 0;
  };

  var diff = cmp (a.major, b.major);
  if (diff != 0)
    return diff;
  diff = cmp (a.minor, b.minor);
  if (diff != 0)
    return diff;
  diff = cmp (a.subminor, b.subminor);
  if (diff != 0)
    return diff;
  diff = cmp (a.subminor, b.subminor);
  if (diff != 0)
    return diff;
  diff = cmp (a.branch == "dev" ? 1 : 0, b.branch == "dev" ? 1 : 0);
  if (diff != 0)
    return diff;
  diff = cmp (a.offset, b.offset);
  return diff;
}

/* String conversion to 32-bit floating-point number represented
   as `uint<32>'.  */

fun stof = (string s) uint<32>:
{
  var f = asm any: ("stof" : s);

  if (asm int<32>: ("nn; nip" : f))
    return f as uint<32>;
  raise Exception {
    code = EC_conv,
    name = "conversion error",
    msg = format ("string '%s' is not a valid floating-point number", s),
    exit_status = 1,
  };
}

/* String conversion to 64-bit floating-point number represented
   as `uint<64>'.  */

fun stod = (string s) uint<64>:
{
  var d = asm any: ("stod" : s);

  if (asm int<32>: ("nn; nip" : d))
    return d as uint<64>;
  raise Exception {
    code = EC_conv,
    name = "conversion error",
    msg = format ("string '%s' is not a valid floating-point number", s),
    exit_status = 1,
  };
}
