khipu/cons.hpp

/* Declarations for the cons type.

   This file is part of khipu.

   khipu is free software: you can redistribute it and/or modify
   it under the terms of the GNU Lesser 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 Lesser General Public License for more details.

   You should have received a copy of the GNU Lesser General Public License
   along with this program.  If not, see <https://www.gnu.org/licenses/>.  */

#ifndef __KP_CONS__
#define __KP_CONS__   1

#include "interp.hpp"
#include "initop.hpp"

KP_DECLS_BEGIN

/* Conses do not possess a header, and pointers to conses are
 * marked specially as well. This means, on the other hand,
 * that they work a bit differently than other objects. */
struct alignas (8) cons
{
  static const int code = typecode::CONS;

  object car;
  object cdr;

  object as_obj () const
    {
#ifdef KP_ARCH_WIDE
      return (ptrtype (this, typecode::CONS));
#else
      return ((object)this | 2);
#endif
    }

  static result<object> make (interpreter *interp, object car, object cdr);

  struct iter_base
    {
      int state = 0;

      inline object _Advance (object& fast, object& slow);
    };

  struct unsafe_iter : public iter_base
    {
      object fast;
      object slow;

      unsafe_iter (object cons) : fast (cons), slow (cons)
        {
        }

      inline bool valid () const;
      inline object& operator* ();
      inline object operator* () const;

      bool circular () const
        {
          return (this->fast == UNBOUND);
        }

      unsafe_iter& operator++ ()
        {
          this->_Advance (this->fast, this->slow);
          return (*this);
        }

      unsafe_iter operator++ (int)
        {
          unsafe_iter rv = *this;
          ++*this;
          return (rv);
        }

      object node () const
        {
          return (this->fast);
        }

      object prev_node () const
        {
          return (this->slow);
        }
    };

  struct safe_iter : public iter_base
    {
      valref fast;
      valref slow;
      valref value;

      inline safe_iter (interpreter *interp, object cons);

      safe_iter (interpreter *interp, const safe_iter& right) :
          fast (interp, *right.fast), slow (interp, *right.slow),
          value (interp, *right.value)
        {
        }

      void reset (const safe_iter& right)
        {
          *this->slow = *right.slow;
          *this->fast = *right.fast;
          *this->value = *right.value;
        }

      inline bool valid () const;
      inline object operator* () const;

      bool circular () const
        {
          return (*this->fast == UNBOUND);
        }

      safe_iter& operator++ ()
        {
          *this->value = this->_Advance (*this->fast, *this->slow);
          return (*this);
        }

      safe_iter operator++ (int)
        {
          safe_iter rv { interpreter::self (), *this };
          ++*this;
          return (rv);
        }

      object node () const
        {
          return (*this->fast);
        }

      object prev_node () const
        {
          return (*this->slow);
        }
    };

  typedef safe_iter iterator;

  // GC-specific methods.
  bool gc_mark ();
  bool old_gen_p () const;
};

static_assert (alignof (cons) % 8 == 0 && sizeof (cons) == 2 * sizeof (object),
               "invalid alignment/size for conses");

KP_EXPORT const object NIL;

#ifdef KP_ARCH_WIDE

inline constexpr bool xcons_p (object obj)
{
  return (itype (obj) == typecode::CONS);
}

#else

inline constexpr bool xcons_p (object obj)
{
  return ((obj & 3) == 2);
}

#endif

inline bool cons_p (object obj)
{
  return (obj != NIL && xcons_p (obj));
}

inline bool atom_p (object obj)
{
  return (!cons_p (obj));
}

inline cons* as_cons (object obj)
{
  return ((cons *)unmask (obj));
}

// Fast, unsafe access.
inline object& xcar (object obj)
{
  return (as_cons(obj)->car);
}

inline object& xcdr (object obj)
{
  return (as_cons(obj)->cdr);
}

inline object& xcadr (object obj)
{
  return (xcar (xcdr (obj)));
}

inline object& xcddr (object obj)
{
  return (xcdr (xcdr (obj)));
}

object cons::iter_base::_Advance (object& fast, object& slow)
{
  fast = xcdr (fast);

  if (fast == slow)
    fast = UNBOUND;
  else if (this->state == 1)
    slow = xcdr (slow);

  this->state ^= 1;
  return (xcons_p (fast) ? xcar (fast) : UNBOUND);
}

bool cons::unsafe_iter::valid () const
{
  return (cons_p (this->fast));
}

object& cons::unsafe_iter::operator* ()
{
  return (xcar (this->fast));
}

object cons::unsafe_iter::operator* () const
{
  return (xcar (this->fast));
}

object cons::safe_iter::operator* () const
{
  return (xcar (*this->fast));
}

cons::safe_iter::safe_iter (interpreter *interp, object cns) :
  fast (interp, cns), slow (interp, cns), value (interp, xcar (cns))
{
}

bool cons::safe_iter::valid () const
{
  return (cons_p (*this->fast));
}

// Allocate a single cons.
KP_EXPORT result<object> alloc_cons (interpreter *interp);

/* Allocate N conses, filling each of their CARs with FILL. If non-null,
 * store the last CDR in *TAIL. */
KP_EXPORT result<object> alloc_cons (interpreter *interp, uint32_t n,
                                     object fill = 0, object **tail = nullptr);

// Same as above, only this fill the CARs with the elements in *ARGV.
KP_EXPORT result<object> alloc_cons (interpreter *interp, uint32_t n,
                                     object *argv, object **tail);

// Return the length of the list CONS. Place its tail in DOTC.
KP_EXPORT int32_t len_L (interpreter *interp, object cons, object& dotc);

// Same as above, only it raises an exception if CONS is not a proper list.
KP_EXPORT result<int32_t> len_L (interpreter *interp, object cons);

// Index a list.
KP_EXPORT result<object> get_L (interpreter *interp,
                                object cons, object idx, object dfl);

// Get the subsequence of a list.
KP_EXPORT result<object> subseq_L (interpreter *interp,
                                   object cons, object i1, object i2);

// Destructively set an object inside a list.
KP_EXPORT result<object> nput_L (interpreter *interp,
                                 object cons, object idx, object val);

// Copy a list.
KP_EXPORT result<object> copy_L (interpreter *interp, object obj, bool deep);

// Concatenate lists L1 and L2.
KP_EXPORT result<object> add_LL (interpreter *interp, object l1, object l2);

// Concate ARGC lists inside ARGV.
KP_EXPORT result<object> concat_L (interpreter *interp, object *argv, int argc);

// Compute the hashcode of a list.
KP_EXPORT result<uint32_t> hash_L (interpreter *interp, object obj);

// Iterator interface for a list.
KP_EXPORT result<object> iter_L (interpreter *interp,
                                 object obj, object token, bool adv);

// Write a list to a stream.
KP_EXPORT result<int64_t> write_L (interpreter *interp,
                                   stream *strm, object obj, io_info& info);

// Serialize a list in a stream.
KP_EXPORT result<int64_t> pack_L (interpreter *interp,
                                  stream *strm, object obj, pack_info& info);

// Deserialize a list from a stream.
KP_EXPORT result<object> unpack_L (interpreter *interp,
                                   stream *strm, pack_info& info, bool save);

// Reverse a list.
KP_EXPORT result<object> reverse_L (interpreter *interp, object obj);

// Destructively reverse a list.
KP_EXPORT result<object> nreverse_L (interpreter *interp, object obj);

// Destructively sort a list.
KP_EXPORT result<object> nsort_L (interpreter *interp,
                                  object obj, comparator& c);

// Test for list equality.
KP_EXPORT result<bool> eq_LL (interpreter *interp, object l1, object l2);

// Compare lists L1 and L2.
KP_EXPORT result<int> cmp_LL (interpreter *interp, object l1, object l2);

// Return the IDX'th cdr of list LST.
KP_EXPORT result<object> nthcdr (interpreter *interp, object idx, object lst);

// Get the last cdr of list LST.
KP_EXPORT result<object> last_L (interpreter *interp, object lst);

// Destructively concatenate ARGC lists in ARGV.
KP_EXPORT result<object> nconcat (interpreter *interp, object *argv, int argc);

// Destructively reverse LST and concatenate TAIL into it.
KP_EXPORT result<object> nrevconc (interpreter *interp,
                                   object lst, object tail);

// Set the car of LST to OBJ.
KP_EXPORT result<object> nputcar (interpreter *interp, object lst, object obj);

// Set the cdr of LST to OBJ.
KP_EXPORT result<object> nputcdr (interpreter *interp, object lst, object obj);

// Mutate an object inside the list.
KP_EXPORT result<object> nzap_L (interpreter *interp, object obj, object key,
                                 uint32_t flags, object fn,
                                 object *argv, int argc);

// Find an element in a list.
KP_EXPORT result<object> find_L (interpreter *interp, object obj,
                                 object key, object start,
                                 object end, object test);

// Init OP for conses.
KP_EXPORT init_op init_cons;

KP_DECLS_END

#endif