path: root/cppawk-include/cons.h

// cppawk: C preprocessor wrapper around awk
// Kaz Kylheku <kaz@kylheku.com>
//
// BSD-2 License
//
// Redistribution and use in source and binary forms, with or without
// modification, are permitted provided that the following conditions are met:
//
// 1. Redistributions of source code must retain the above copyright notice,
//    this list of conditions and the following disclaimer.
//
// 2. Redistributions in binary form must reproduce the above copyright notice,
//    this list of conditions and the following disclaimer in the documentation
//    and/or other materials provided with the distribution.
//
// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
// POSSIBILITY OF SUCH DAMAGE.

#ifndef __CPPAWK_CONS_H
#define __CPPAWK_CONS_H

#ifndef __CPPAWK_BASE_H
#include "base.h"
#endif

#ifndef __CPPAWK_ITER_H
#include "iter.h"
#endif

#ifndef __CPPAWK_CASE_PRIV_H
#include "case-priv.h"
#endif

#ifndef __CPPAWK_VARG_PRIV_H
#include "varg-priv.h"
#endif

#ifndef __CPPAWK_NARG_PRIV_H
#include "narg-priv.h"
#endif

#if __have_indirect_functions
#ifndef __CPPAWK_FUN_H
#include "fun.h"
#endif
#endif

#define nil ""

#define __prog_first(expr)  ((expr) || 1)
#define __prog_next(prev,                                                     \
                    expr)   prev && ((expr) || 1)
#define prog(...)           (__varexpand(__prog_first, __prog_next,           \
                                         __VA_ARGS__))

#define __progn_first(expr) (expr)
#define __progn_next(prev,                                                    \
                     next)  ((prev || 1) ? (next) : 0)
#define progn(...)          __varexpand(__progn_first, __progn_next,          \
                                        __VA_ARGS__)

#define __or_first(expr)    (expr)
#define __or_next(prev,                                                       \
                  next)     (false(__g(or) = prev) ? (next) :  __g(or))
#define or(...)             __varexpand(__or_first, __or_next,                \
                                        __VA_ARGS__)

#define __and_first(expr)   (expr)
#define __and_next(prev,                                                      \
                   next)    (false(prev) ? nil : next)
#define and(...)            __varexpand(__and_first, __and_next,              \
                                        __VA_ARGS__)


#define push(item, list)    (list = cons(item, list))

#define pop(list)           (progn(__g(ol) = (list),                          \
                                   list = cdr(__g(ol)),                       \
                                   car(__g(ol))))

#define dolist(item, list)                                                    \
  for (__g(i) = list;                                                         \
       !endp(__g(i)) && ((item = car(__g(i))) || 1);                          \
       __g(i) = cdr(__g(i)))

#define dolisti(item, index, list)                                            \
  for (prog(__g(i) = list, index = 0);                                        \
       !endp(__g(i)) && ((item = car(__g(i))) || 1);                          \
       prog(__g(i) = cdr(__g(i)), index++))

#define list_begin() ""
#define list_add(stk, item) (length(item) ":" item stk)
#define list_end(stk) __unpack(stk)

#define __bag_init_first(x)   (x = list_begin())
#define __bag_init_next(p, x) (p || 1) && __bag_init_first(x)

#define __bag_done_first(x)   (x = list_end(x))
#define __bag_done_next(p, x) (p || 1) && __bag_done_first(x)

#define bags(...)             for ((__g(once) = 1) &&                         \
                                   __varexpand(__bag_init_first,              \
                                               __bag_init_next,               \
                                               __VA_ARGS__);                  \
                                   __g(once) ||                               \
                                   __varexpand(__bag_done_first,              \
                                               __bag_done_next,               \
                                               __VA_ARGS__) && 0;             \
                                   __g(once) = 0)
#define bag(bag, expr)        bag = list_add(bag, expr)

#define typecode(obj) (substr(obj, 1, 1))

function consp(__obj)
{
  return typecode(__obj) == "C"
}
#define consp(obj) (typecode(obj) == "C")

function atom(__obj)
{
  return typecode(__obj) != "C"
}
#define atom(obj) (typecode(obj) != "C")

function null(__obj)
{
  return __obj == nil
}
#define null(obj) ((obj) == nil)

function endp(__obj)
{
  if (__obj == nil)
    return 1
      if (consp(__obj))
        return nil
          __error("endp: a proper list ends with nil, not %s", __obj)
}

#if __config_strict_false
function false(__obj)
{
  return __obj == nil
}
#define false(obj) null(obj)
#else
function false(__obj)
{
  return !obj
}
#define false(obj) (!(obj))
#endif

function true(__obj)
{
  return !false(__obj)
}
#define true(obj) (!false(obj))


function __bs_esc(raw)
{
  gsub(/[\\\042]/, "\\\\&", raw)
    return raw
}

function nump(__obj)
{
  return __obj == 0 || __obj + 0 != 0
}
#define nump(obj) ((obj) == 0 || (obj) + 0 != 0)

function tolisp(__raw,
                __case_temps)
{
  __case (typecode(__raw)) {
    __of ("T", "S", "C")
      __cret ("T" __raw) // represent as unescaped string
    __otherwise
      __cret (__raw)
  }
}

function toawk(__obj,
               __case_temps)
{
  __case (typecode(__obj)) {
    __of ("T", "S")
     __cret (substr(__obj, 2))
    __of ("C")
      __error("toawk: %s looks like a cons", __obj, i)
      __cbreak
    __otherwise
      __cret (__obj)
  }
}

function sym(__name)
{
  return "S" __name
}

function cons(__a, __d)
{
  return "C" length(__a) "," length(__d) ":" __a __d
}

function car(__cons,
             __col, __com, len)
{
  if (consp(__cons)) {
    __col = match(__cons, /:/)
    __com = match(__cons, /,/)
    if (__col == 0 || __com == 0 || __col <= __com)
      __error("car: %s has a malformed cons header", __cons)
    len = substr(__cons, 2, __com - 2 + 1)
    return substr(__cons, __col + 1, len)
  } else if (null(__cons)) {
    return nil
  } else {
    __error("car: %s isn't a cons", __cons)
  }
}

function cdr(__cons,
             __col, __com, __alen, __dlen)
{
  if (consp(__cons)) {
    __col = match(__cons, /:/)
    __com = match(__cons, /,/)
    if (__col == 0 || __com == 0 || __col <= __com)
      __error("car: %s has a malformed cons header", __cons)
    __alen = substr(__cons, 2, __com - 2 + 1)
    __dlen = substr(__cons, __com + 1, __col - __com)
    return substr(__cons, __col + 1 + __alen, __dlen)
  } else if (null(__cons)) {
    return nil
  } else {
    __error("car: %s isn't a cons", __cons)
  }
}

function sexp(__obj,
              __d, __x, __y, __case_temps)
{
  __case (typecode(__obj)) {
    __of ("C")
      __d = cdr(__obj)
      __x = sexp(car(__obj))
      if (null(__d)) {
        return "(" __x ")"
      } else {
        __y = sexp(__d)
        if (typecode(__d) == "C")
          return "(" __x " " substr(__y, 2)
        else
          return "(" __x " . "  __y ")"
      }
      __cbreak
    __of ("T")
      __cret ("\"" __bs_esc(substr(__obj, 2)) "\"")
    __of ("S")
      __cret (__bs_esc(substr(__obj, 2)))
  }

  if (nump(__obj)) {
    return __obj
  } else if (null(__obj)) {
    return "nil"
  } else {
    return "\"" __bs_esc(__obj) "\""
  }
}

function reverse(__list,
                 __tmp)
{
  __tmp = nil

  while (!endp(__list)) {
    push(car(__list), __tmp);
    __list = cdr(__list);
  }

  return __tmp;
}

function atol(__arr,
              __tmp, __key, __value)
{
  __tmp = list_begin()

  doarray (__key, __value, __arr)
    __tmp = list_add(__tmp,__value)

  return list_end(__tmp)
}

function ftol(  __tmp, __i, __val)
{
  __tmp = list_begin()

  dofields (__i, __val)
    __tmp = list_add(__tmp, __val)

  return list_end(__tmp)
}

function ltof(__list, __start,
              __tmp, __item, __n)
{
  if (!__present(__start))
    __start = 1

  dolisti (__item, __n, __list)
    $(__n + __start) = __item

  NF = __n + __start - 1

  return __n
}

function keys(__array,
             __key,  __tmp)
{
  __tmp = list_begin()

  for (__key in __array)
    __tmp = list_add(__tmp, __key)

  return list_end(__tmp)
}

function __slow_equal(__obj1, __obj2,
                      __tc1, __tc2, __case_temps)
{
  __tc1 = typecode(__obj1)
  __tc2 = typecode(__obj2)

  __case (__tc1 __tc2) {
    __of ("CC")
      __cret (equal(car(__obj1), car(__obj2)) &&
              equal(cdr(__obj1), cdr(__obj2)))
    __matching (/[TSC][TSC]/)
      __cret (0);
  }

  if (__tc1 == "T")
    return toawk(__obj1) == __obj2;

  if (__tc2 == "T")
    return __obj1 == toawk(__obj2);

  if (nump(__obj1))
    return __obj1 + 0 == __obj2

  return 0;
}

function equal(__obj1, __obj2)
{
  if (__obj1 == __obj2)
    return 1;
  return __slow_equal(__obj1, __obj2)
}

#define equal(obj1, obj2) ((obj1) == (obj2) ? 1 : __slow_equal(obj1, obj2))

function __unpack(__stk,
                  __col, __out)
{
  __out = nil

  while (__stk != "") {
    __col = match(__stk, /:/)
    if (__col == 0)
      break;
    push(substr(__stk, __col + 1, __stk), __out)
    __stk = substr(__stk, __col + 1 + __stk);
  }

  return __out
}


function list(__rest,
              __check)
{
  return __arglist("list", __rest, __check)
}
#define __list_first(item)        cons(item, nil)
#define __list_next(list, item)   cons(item, list)
#define li(...)                   __varexpand(__list_first,                   \
                                              __list_next,                    \
                                              __revarg(__VA_ARGS__))

#define __listar_first(item)     item
#define listar(...)              __varexpand(__listar_first,                  \
                                             __list_next,                     \
                                             __revarg(__VA_ARGS__))

function __append(__left, __right,
                  tmp)
{
  tmp = reverse(__left)
  while (!endp(tmp))
    __right = cons(pop(tmp), __right)
  return __right
}

function append(__rest,
                __count, __out)
{
  __varg_count("append", __count, __count)
  __out = nil
  __case (__count) {
    __of (32)
      __out = __r32
      __cbreak
    __of (31)
      __out = __r31
      __cbreak
    __of (30)
      __out = __r30
      __cbreak
    __of (29)
      __out = __r29
      __cbreak
    __of (28)
      __out = __r28
      __cbreak
    __of (27)
      __out = __r27
      __cbreak
    __of (26)
      __out = __r26
      __cbreak
    __of (25)
      __out = __r25
      __cbreak
    __of (24)
      __out = __r24
      __cbreak
    __of (23)
      __out = __r23
      __cbreak
    __of (22)
      __out = __r22
      __cbreak
    __of (21)
      __out = __r21
      __cbreak
    __of (20)
      __out = __r20
      __cbreak
    __of (19)
      __out = __r19
      __cbreak
    __of (18)
      __out = __r18
      __cbreak
    __of (17)
      __out = __r17
      __cbreak
    __of (16)
      __out = __r16
      __cbreak
    __of (15)
      __out = __r15
      __cbreak
    __of (14)
      __out = __r14
      __cbreak
    __of (13)
      __out = __r13
      __cbreak
    __of (12)
      __out = __r12
      __cbreak
    __of (11)
      __out = __r11
      __cbreak
    __of (10)
      __out = __r10
      __cbreak
    __of (9)
      __out = __r9
      __cbreak
    __of (8)
      __out = __r8
      __cbreak
    __of (7)
      __out = __r7
      __cbreak
    __of (6)
      __out = __r6
      __cbreak
    __of (5)
      __out = __r5
      __cbreak
    __of (4)
      __out = __r4
      __cbreak
    __of (3)
      __out = __r3
      __cbreak
    __of (2)
      __out = __r2
      __cbreak
    __of (1)
      __out = __r1
      __cbreak
  }
  __case (__count - 1) {
    __of (31)
      __out = __append(__r31, __out)
      __cfall
    __of (30)
      __out = __append(__r30, __out)
      __cfall
    __of (29)
      __out = __append(__r29, __out)
      __cfall
    __of (28)
      __out = __append(__r28, __out)
      __cfall
    __of (27)
      __out = __append(__r27, __out)
      __cfall
    __of (26)
      __out = __append(__r26, __out)
      __cfall
    __of (25)
      __out = __append(__r25, __out)
      __cfall
    __of (24)
      __out = __append(__r24, __out)
      __cfall
    __of (23)
      __out = __append(__r23, __out)
      __cfall
    __of (22)
      __out = __append(__r22, __out)
      __cfall
    __of (21)
      __out = __append(__r21, __out)
      __cfall
    __of (20)
      __out = __append(__r20, __out)
      __cfall
    __of (19)
      __out = __append(__r19, __out)
      __cfall
    __of (18)
      __out = __append(__r18, __out)
      __cfall
    __of (17)
      __out = __append(__r17, __out)
      __cfall
    __of (16)
      __out = __append(__r16, __out)
      __cfall
    __of (15)
      __out = __append(__r15, __out)
      __cfall
    __of (14)
      __out = __append(__r14, __out)
      __cfall
    __of (13)
      __out = __append(__r13, __out)
      __cfall
    __of (12)
      __out = __append(__r12, __out)
      __cfall
    __of (11)
      __out = __append(__r11, __out)
      __cfall
    __of (10)
      __out = __append(__r10, __out)
      __cfall
    __of (9)
      __out = __append(__r9, __out)
      __cfall
    __of (8)
      __out = __append(__r8, __out)
      __cfall
    __of (7)
      __out = __append(__r7, __out)
      __cfall
    __of (6)
      __out = __append(__r6, __out)
      __cfall
    __of (5)
      __out = __append(__r5, __out)
      __cfall
    __of (4)
      __out = __append(__r4, __out)
      __cfall
    __of (3)
      __out = __append(__r3, __out)
      __cfall
    __of (2)
      __out = __append(__r2, __out)
      __cfall
    __of (1)
      __out = __append(__r1, __out)
      __cfall
  }

  return __out
}

function member(__item, __list)
{
  while (!endp(__list)) {
    if (equal(__item, car(__list)))
      return __list;
    __list = cdr(__list)
  }

  return nil
}

function position(__item, __list,
                  __pos)
{
  for (__pos = 0; !endp(__list); __pos++) {
    if (equal(__item, car(__list)))
      return __pos;
    __list = cdr(__list)
  }

  return nil
}

function nth(__pos, __list)
{
  for (; __pos > 0 && !endp(__list); __pos--)
    __list = cdr(__list)
  return car(__list)
}

function nthcdr(__pos, __list)
{
  for (; __pos > 0 && !endp(__list); __pos--)
    __list = cdr(__list)
  return __list
}

function iota(__from, __to, __step,
              i, __out)
{
  __out = list_begin();

  if (__from < __to) {
    if (!__present(__step))
      __step = 1
    if (__step > 0)
      for (__i = __from; __i <= __to; __i += __step)
        __out = list_add(__out, __i)
  } else {
    if (!__present(__step))
      __step = -1
    if (__step < 0)
      for (__i = __from; __i >= __to; __i += __step)
        __out = list_add(__out, __i)
  }

  return list_end(__out)
}

function uniq(__list,
              __out, __item, __seen)
{
  __out = list_begin();

  dolist(__item, __list) {
    if (__item in __seen)
      continue
    __seen[__item]
    __out = list_add(__out, __item)
  }

  return list_end(__out)
}

#if __have_indirect_functions

function mapcar(__fun, __list,
                __temp, __item, out)
{
  __temp = list_begin()
  dolist(__item, __list)
    __temp = list_add(__temp, call(__fun, __item))
  return list_end(__temp)
}

function mappend(__fun, __list,
                __temp, __item, out)
{
  __temp = nil
  dolist(__item, __list)
    __temp = __append(__temp, call(__fun, __item))
  return __temp
}

#endif

#endif