khipu/symbol.hpp

/* Declarations for the symbol and package types.

   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_SYMBOL__
#define __KP_SYMBOL__   1

#include "thread.hpp"
#include "initop.hpp"

KP_DECLS_BEGIN

// Special forms' descriptors.
enum
{
  SF_IF,
  SF_DO,
  SF_FCT,
  SF_AND,
  SF_OR,
  SF_WHILE,
  SF_BREAK,
  SF_CONTINUE,
  SF_RETURN,
  SF_SETQ,
  SF_QUOTE,
  SF_TRY,
  SF_LET,
  SF_RECUR,
  SF_YIELD,
  SF_CALLCC,
  SF_RAISE,
  SF_LAST_NO
};

struct symbol : public finobj
{
  static const int literal_flag = 1 << 22;
  static const int specform_flag = 1 << 21;
  static const int special_flag = 1 << 20;
  static const int ctv_flag = 1 << 19;
  static const int alias_flag = 1 << 18;

  static const int code = typecode::SYMBOL;

  object name;
  object pkg;
  object value;
  intptr_t idx;
  uintptr_t tl_idx;

  static result<object> make_kword (interpreter *interp, object name);
  static result<object> make_kword (interpreter *interp, const char *name);
  static result<object> make_kword (interpreter *interp,
                                    const char *name, int len);

  // Some exported symbols.
  static object t;
  static object comma;
  static object comma_at;
  static object comma_dot;
  static object backquote;
  static object quote;
  static object nil;
  static object meth_curr;

  static const uint32_t N_SPECFORMS = SF_LAST_NO;
  static object fast_global_syms[];

  static int specform_byname (const void *name, uint32_t len);
  static int specform_byname (const void *name);

  static result<uintptr_t> alloc_tl_idx (interpreter *interp);
};

struct package : public finobj
{
  static const int code = typecode::PKG;

  object syms;
  object name;
  object path;
  object canonical_path;
  atomic_t lock;
  dlist pkg_link;

  struct iterator
    {
      uint32_t idx;
      valref symtab;
      valref cursym;

      iterator (interpreter *interp, object pkg);

      iterator (interpreter *interp, uint32_t i,
        object tab, object sym) : idx (i),
          symtab (interp, tab), cursym (interp, sym)
        {
        }

      bool valid () const;
      iterator& operator++ ();

      iterator operator++ (int)
        {
          iterator rv { interpreter::self (),
            this->idx, *this->symtab, *this->cursym };
          ++*this;
          return (rv);
        }

      object operator* () const
        {
          return (*this->cursym);
        }
    };
};

inline symbol* as_symbol (object obj)
{
  return ((symbol *)unmask (obj));
}

inline package* as_package (object obj)
{
  return ((package *)unmask (obj));
}

inline object& symname (object obj)
{
  return (as_symbol(obj)->name);
}

inline object& symval (object obj)
{
  return (as_symbol(obj)->value);
}

inline object& sympkg (object obj)
{
  return (as_symbol(obj)->pkg);
}

inline uintptr_t& symtlidx (object obj)
{
  return (as_symbol(obj)->tl_idx);
}

inline object& symval (interpreter *interp, object obj)
{
  symbol *sp = as_symbol (obj);
  return (!sp->tl_idx || sp->tl_idx >= interp->n_tlsyms ||
          interp->tl_syms[sp->tl_idx - 1] == UNBOUND ?
          sp->value : interp->tl_syms[sp->tl_idx - 1]);
}

inline bool symbol_p (object obj)
{
  return (itype (obj) == typecode::SYMBOL);
}

inline bool package_p (object obj)
{
  return (itype (obj) == typecode::PKG);
}

KP_EXPORT object root_package;
KP_EXPORT object kword_package;

inline bool keyword_p (object obj)
{
  return (symbol_p (obj) && sympkg (obj) == kword_package);
}

inline bool nksymbol_p (object obj)
{
  return (symbol_p (obj) && sympkg (obj) != kword_package);
}

struct stream;
struct io_info;
struct pack_info;

/* Allocate a package named NAME. If BOOTSTRAP is true, the returned
 * package does not inherit any symbols from the root package. */
KP_EXPORT result<object> alloc_pkg (interpreter *interp, object name,
                                    bool bootstrap = false);

// Allocate a package named NAME, from path PATH.
KP_EXPORT result<object> alloc_pkg (interpreter *interp, object name,
                                    object path = UNBOUND);

// Allocate an uninterned symbol.
KP_EXPORT result<object> alloc_sym (interpreter *interp, uint32_t flags = 0);

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

// Compute the hash value of a symbol.
KP_EXPORT uint32_t hash_S (interpreter *interp, object obj);

// Compute the hash value of a package.
KP_EXPORT uint32_t hash_P (interpreter *interp, object obj);

// Find a symbol named NAME in package PKG. Returns a non-symbol if not found.
KP_EXPORT object find_sym (interpreter *interp, object pkg, object name);

KP_EXPORT object find_sym (interpreter *interp, object pkg, const char *name);

KP_EXPORT object find_sym (interpreter *interp, object pkg,
                           const char *name, uint32_t len);

inline object find_sym (interpreter *interp, const char *name)
{
  return (find_sym (interp, root_package, name));
}

inline object find_sym (interpreter *interp, const char *name, uint32_t len)
{
  return (find_sym (interp, root_package, name, len));
}

struct string;
struct reader;

/* Intern a symbol named NAME in package PKGP, with flags FLAGS.
 * If the package is null, intern it in the root package. */
KP_EXPORT result<object> intern (interpreter *interp, const char *name,
                                 uint32_t len, package *pkgp = nullptr,
                                 uint32_t flags = 0);

KP_EXPORT result<object> intern (interpreter *interp, const char *name,
                                 package *pkgp = nullptr, uint32_t flags = 0);

KP_EXPORT result<object> intern (interpreter *interp, const string *name,
                                 package *pkgp = nullptr, uint32_t flags = 0);

/* Remove the symbol named NAME from package PKGP.
 * If the package is null, remove it from the root package. */
KP_EXPORT result<bool> undef (interpreter *interp, const char *name,
                              uint32_t len, package *pkgp = nullptr);

KP_EXPORT result<bool> undef (interpreter *interp, object sym);

// Index a package. The key may be a string or keyword.
KP_EXPORT result<object> get_P (interpreter *interp,
                                object pkg, object key, object dfl);

// Associate the symbol KEY to value VAL in package PKG.
KP_EXPORT result<object> nput_P (interpreter *interp,
                                 object pkg, object key, object val);

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

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

// Serialize a symbol to a stream.
KP_EXPORT result<int64_t> pack_S (interpreter *interp,
                                  stream *strm, object obj, pack_info& info);

// Serialize a package to a stream.
KP_EXPORT result<int64_t> pack_P (interpreter *interp,
                                  stream *strm, object obj, pack_info& info);

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

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

// Generate a unique, uninterned symbol.
KP_EXPORT result<object> gensym (interpreter *interp, object *argv, int argc);

// Compile a package, returning the equivalent thunk.
KP_EXPORT result<object> compile_pkg (interpreter *interp, reader& rd);

// Pull a package, or some symbols from it.
KP_EXPORT result<object> pull_pkg (interpreter *interp,
                                   object name, object arg_1, object arg_2);

// Mutate the value associated to a symbol in a package.
KP_EXPORT result<object> nzap_P (interpreter *interp, object obj, object key,
                                 uint32_t flags, object fn,
                                 object *argv, int argc);

// Init OP for symbols.
KP_EXPORT init_op init_symbols;

KP_DECLS_END

#endif