<commit_before>#include <stdio.h>
#include <string.h>
#include <errno.h>
#include <gmp.h>
#include "object.h"
#include "cons.h"
#include "symtab.h"
#include "common.h"
#include "eval.h"
#include "str.h"
#include "reader.h"
#include "number.h"
#include "vector.h"
#include "detach.h"

/* From lisp_math.c */
void lisp_math_init ();
object_t *num_eq (object_t * lst);

/* Various basic stuff */

object_t *cdoc_string (object_t * lst)
{
  DOC ("Return doc-string for CFUNC or SPECIAL.");
  REQ (lst, 1, c_sym ("cdoc-string"));
  object_t *fo = CAR (lst);
  int evaled = 0;
  if (SYMBOLP (fo))
    {
      evaled = 1;
      fo = eval (fo);
    }
  if (fo->type != CFUNC && fo->type != SPECIAL)
    {
      if (evaled)
	obj_destroy (fo);
      THROW (wrong_type, UPREF (fo));
    }
  cfunc_t f = FVAL (fo);
  object_t *str = f (doc_string);
  if (evaled)
    obj_destroy (fo);
  return str;
}

object_t *lisp_apply (object_t * lst)
{
  DOC ("Apply function to a list.");
  REQ (lst, 2, c_sym ("apply"));
  object_t *f = CAR (lst);
  object_t *args = CAR (CDR (lst));
  if (!LISTP (args))
    THROW (wrong_type, UPREF (args));
  return apply (f, args);
}

object_t *lisp_and (object_t * lst)
{
  DOC ("Evaluate each argument until one returns nil.");
  object_t *r = T, *p = lst;
  while (CONSP (p))
    {
      obj_destroy (r);
      r = eval (CAR (p));
      CHECK (r);
      if (r == NIL)
	return NIL;
      p = CDR (p);
    }
  if (p != NIL)
    THROW (improper_list, UPREF (lst));
  return UPREF (r);
}

object_t *lisp_or (object_t * lst)
{
  DOC ("Evaluate each argument until one doesn't return nil.");
  object_t *r = NIL, *p = lst;
  while (CONSP (p))
    {
      r = eval (CAR (p));
      CHECK (r);
      if (r != NIL)
	return UPREF (r);
      p = CDR (p);
    }
  if (p != NIL)
    THROW (improper_list, UPREF (lst));
  return NIL;
}

object_t *lisp_cons (object_t * lst)
{
  DOC ("Construct a new cons cell, given car and cdr.");
  REQ (lst, 2, c_sym ("cons"));
  return c_cons (UPREF (CAR (lst)), UPREF (CAR (CDR (lst))));
}

object_t *lisp_quote (object_t * lst)
{
  DOC ("Return argument unevaluated.");
  REQ (lst, 1, c_sym ("quote"));
  return UPREF (CAR (lst));
}

object_t *lambda_f (object_t * lst)
{
  DOC ("Create an anonymous function.");
  if (!is_func_form (lst))
    THROW (c_sym ("bad-function-form"), UPREF (lst));
  return c_cons (lambda, UPREF (lst));
}

object_t *defun (object_t * lst)
{
  DOC ("Define a new function.");
  if (!SYMBOLP (CAR (lst)) || !is_func_form (CDR (lst)))
    THROW (c_sym ("bad-function-form"), UPREF (lst));
  object_t *f = c_cons (lambda, UPREF (CDR (lst)));
  SET (CAR (lst), f);
  return UPREF (CAR (lst));
}

object_t *defmacro (object_t * lst)
{
  DOC ("Define a new macro.");
  if (!SYMBOLP (CAR (lst)) || !is_func_form (CDR (lst)))
    THROW (c_sym ("bad-function-form"), UPREF (lst));
  object_t *f = c_cons (macro, UPREF (CDR (lst)));
  SET (CAR (lst), f);
  return f;
}

object_t *lisp_cdr (object_t * lst)
{
  DOC ("Return cdr element of cons cell.");
  REQ (lst, 1, c_sym ("cdr"));
  if (CAR (lst) == NIL)
    return NIL;
  if (!LISTP (CAR (lst)))
    THROW (wrong_type, CAR (lst));
  return UPREF (CDR (CAR (lst)));
}

object_t *lisp_car (object_t * lst)
{
  DOC ("Return car element of cons cell.");
  REQ (lst, 1, c_sym ("car"));
  if (CAR (lst) == NIL)
    return NIL;
  if (!LISTP (CAR (lst)))
    THROW (wrong_type, CAR (lst));<commit_msg>Changed defmacro to behave more like defun.<commit_after>#include <stdio.h>
#include <string.h>
#include <errno.h>
#include <gmp.h>
#include "object.h"
#include "cons.h"
#include "symtab.h"
#include "common.h"
#include "eval.h"
#include "str.h"
#include "reader.h"
#include "number.h"
#include "vector.h"
#include "detach.h"

/* From lisp_math.c */
void lisp_math_init ();
object_t *num_eq (object_t * lst);

/* Various basic stuff */

object_t *cdoc_string (object_t * lst)
{
  DOC ("Return doc-string for CFUNC or SPECIAL.");
  REQ (lst, 1, c_sym ("cdoc-string"));
  object_t *fo = CAR (lst);
  int evaled = 0;
  if (SYMBOLP (fo))
    {
      evaled = 1;
      fo = eval (fo);
    }
  if (fo->type != CFUNC && fo->type != SPECIAL)
    {
      if (evaled)
	obj_destroy (fo);
      THROW (wrong_type, UPREF (fo));
    }
  cfunc_t f = FVAL (fo);
  object_t *str = f (doc_string);
  if (evaled)
    obj_destroy (fo);
  return str;
}

object_t *lisp_apply (object_t * lst)
{
  DOC ("Apply function to a list.");
  REQ (lst, 2, c_sym ("apply"));
  object_t *f = CAR (lst);
  object_t *args = CAR (CDR (lst));
  if (!LISTP (args))
    THROW (wrong_type, UPREF (args));
  return apply (f, args);
}

object_t *lisp_and (object_t * lst)
{
  DOC ("Evaluate each argument until one returns nil.");
  object_t *r = T, *p = lst;
  while (CONSP (p))
    {
      obj_destroy (r);
      r = eval (CAR (p));
      CHECK (r);
      if (r == NIL)
	return NIL;
      p = CDR (p);
    }
  if (p != NIL)
    THROW (improper_list, UPREF (lst));
  return UPREF (r);
}

object_t *lisp_or (object_t * lst)
{
  DOC ("Evaluate each argument until one doesn't return nil.");
  object_t *r = NIL, *p = lst;
  while (CONSP (p))
    {
      r = eval (CAR (p));
      CHECK (r);
      if (r != NIL)
	return UPREF (r);
      p = CDR (p);
    }
  if (p != NIL)
    THROW (improper_list, UPREF (lst));
  return NIL;
}

object_t *lisp_cons (object_t * lst)
{
  DOC ("Construct a new cons cell, given car and cdr.");
  REQ (lst, 2, c_sym ("cons"));
  return c_cons (UPREF (CAR (lst)), UPREF (CAR (CDR (lst))));
}

object_t *lisp_quote (object_t * lst)
{
  DOC ("Return argument unevaluated.");
  REQ (lst, 1, c_sym ("quote"));
  return UPREF (CAR (lst));
}

object_t *lambda_f (object_t * lst)
{
  DOC ("Create an anonymous function.");
  if (!is_func_form (lst))
    THROW (c_sym ("bad-function-form"), UPREF (lst));
  return c_cons (lambda, UPREF (lst));
}

object_t *defun (object_t * lst)
{
  DOC ("Define a new function.");
  if (!SYMBOLP (CAR (lst)) || !is_func_form (CDR (lst)))
    THROW (c_sym ("bad-function-form"), UPREF (lst));
  object_t *f = c_cons (lambda, UPREF (CDR (lst)));
  SET (CAR (lst), f);
  return UPREF (CAR (lst));
}

object_t *defmacro (object_t * lst)
{
  DOC ("Define a new macro.");
  if (!SYMBOLP (CAR (lst)) || !is_func_form (CDR (lst)))
    THROW (c_sym ("bad-function-form"), UPREF (lst));
  object_t *f = c_cons (macro, UPREF (CDR (lst)));
  SET (CAR (lst), f);
  return UPREF (CAR (lst));
}

object_t *lisp_cdr (object_t * lst)
{
  DOC ("Return cdr element of cons cell.");
  REQ (lst, 1, c_sym ("cdr"));
  if (CAR (lst) == NIL)
    return NIL;
  if (!LISTP (CAR (lst)))
    THROW (wrong_type, CAR (lst));
  return UPREF (CDR (CAR (lst)));
}

object_t *lisp_car (object_t * lst)
{
  DOC ("Return car element of cons cell.");
  REQ (lst, 1, c_sym ("car"));
  if (CAR (lst) == NIL)
    return NIL;
  if (!LISTP (CAR (lst)))
    THROW (wrong_type, CAR (lst));
{'fraction_non_alphanumeric': 0.18103699388290126, 'fraction_numerical': 0.002330323332362365, 'mean_word_length': 3.177007299270073, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 15, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3563807', 'n_tokens_mistral': 2939, 'n_tokens_neox': 2812, 'n_words': 857}