<commit_before>/**
 * See Copyright Notice in picrin.h
 */

#include <stdio.h>
#include <assert.h>

#include "picrin.h"
#include "picrin/pair.h"
#include "picrin/irep.h"
#include "picrin/proc.h"
#include "picrin/lib.h"
#include "picrin/macro.h"
#include "xhash/xhash.h"

#if PIC_NONE_IS_FALSE
# define OP_PUSHNONE OP_PUSHFALSE
#else
# error enable PIC_NONE_IS_FALSE
#endif

static pic_sym *
analyze_args(pic_state *pic, pic_value args, bool *varg, int *argc, int *localc)
{
  pic_sym *syms = (pic_sym *)pic_alloc(pic, sizeof(pic_sym));
  int i = 1, l = 0;
  pic_value v;

  *varg = false;
  for (v = args; pic_pair_p(v); v = pic_cdr(pic, v)) {
    pic_value sym;

    sym = pic_car(pic, v);
    if (! pic_sym_p(sym)) {
      pic_free(pic, syms);
      return NULL;
    }
    syms = (pic_sym *)pic_realloc(pic, syms, sizeof(pic_sym) * (i + 1));
    syms[i] = pic_sym(sym);
    i++;
  }
  if (pic_nil_p(v)) {
    /* pass */
  }
  else if (pic_sym_p(v)) {
    *varg = true;
    syms = (pic_sym *)pic_realloc(pic, syms, sizeof(pic_sym) * (i + 1));
    syms[i] = pic_sym(v);
    l++;
  }
  else {
    pic_free(pic, syms);
    return NULL;
  }
  *argc = i;
  *localc = l;

  return syms;
}

static bool
valid_formal(pic_state *pic, pic_value formal)
{
  bool varg;
  int argc, localc;
  pic_sym *syms;

  syms = analyze_args(pic, formal, &varg, &argc, &localc);
  if (syms == NULL) {
    return false;
  }
  else {
    pic_free(pic, syms);
    return true;
  }
}

typedef struct analyze_scope {
  /* rest args variable is counted by localc */
  bool varg;
  int argc, localc;
  /* if variable v is captured, then xh_get(var_tbl, v) == 1 */
  struct xhash *var_tbl;
  pic_sym *vars;

  struct analyze_scope *up;
} analyze_scope;

typedef struct analyze_state {
  pic_state *pic;
  analyze_scope *scope;
  pic_sym rCONS, rCAR, rCDR, rNILP;
  pic_sym rADD, rSUB, rMUL, rDIV;
  pic_sym rEQ, rLT, rLE, rGT, rGE, rNOT;
  pic_sym sCALL, sTAILCALL, sREF, sRETURN;
} analyze_state;

static void push_scope(analyze_state *, pic_value);
static void pop_scope(analyze_state *);

#define register_symbol(pic, state, slot, name) do {    \
    state->slot = pic_intern_cstr(pic, name);           \
  } while (0)

#define register_renamed_symbol(pic, state, slot, lib, name) do {       \
    struct xh_entry *e;                                                 \
    if (! (e = xh_get(lib->senv->tbl, name)))                           \
      pic_error(pic, "internal error! native VM procedure not found");  \
    state->slot = e->val;                                               \
  } while (0)

static analyze_state *
new_analyze_state(pic_state *pic)
{
  analyze_state *state;
  struct xhash *global_tbl;
  struct xh_iter it;
  struct pic_lib *stdlib;

  state = (analyze_state *)pic_alloc(pic, sizeof(analyze_state));
  state->pic = pic;
  state->scope = NULL;

  stdlib = pic_find_library(pic, pic_parse(pic, "(scheme base)"));

  /* native VM procedures */
  register_renamed_symbol(pic, state, rCONS, stdlib, "cons");
  register_renamed_symbol(pic, state, rCAR, stdlib, "car");
  register_renamed_symbol(pic, state, rCDR, stdlib, "cdr");
  register_renamed_symbol(pic, state, rNILP, stdlib, "null?");
  register_renamed_symbol(pic, state, rADD, stdlib, "+");
  register_renamed_symbol(pic, state, rSUB, stdlib, "-");
  register_renamed_symbol(pic, state, rMUL, stdlib, "*");
  register_renamed_symbol(pic, state, rDIV, stdlib, "/");
  register_renamed_symbol(pic, state, rEQ, stdlib, "=");
  register_renamed_symbol(pic, state, rLT, stdlib, "<");
  register_renamed_symbol(pic, state, rLE, stdlib, "<=");
  register_renamed_symbol(pic, state, rGT, stdlib, ">");
  register_renamed_symbol(pic, state, rGE, stdlib, ">=");
  register_renamed_symbol(pic, state, rNOT, stdlib, "not");

  register_symbol(pic, state, sCALL, "call");
  register_symbol(pic, state, sTAILCALL, "tail-call");
  register_symbol(pic, state, sREF, "ref");
  register_symbol(pic, state, sRETURN, "return");

  /* push initial scope */
  push_scope(state, pic_nil_value());

  global_tbl = pic->global_tbl;
  for (xh_begin(global_tbl, &it); ! xh_isend(&it); xh_next(&it)) {
    xh_put(state->scope->var_tbl, it.e->key, 0);
  }

  return state;
}

static void
destroy_analyze_state(analyze_state *state)
{
  pop_scope(state);
  pic_free(state->pic, state);
}

static void
push_scope(analyze_state *state, pic_value args)
{
  pic_state *pic = state->pic;
  analyze_scope *scope;
  int i;

  scope = (analyze_scope *)pic_alloc(pic, sizeof(analyze_scope));
  scope->up = state->scope;
  scope->var_tbl = xh_new();
  scope->varg = false;
  scope->vars = analyze_args(pic, args, &scope->varg, &scope->argc, &scope->localc);

  if (scope->vars == NULL) {
    pic_error(pic, "logic flaw");
  }

  for (i = 1; i < scope->argc + scope->localc; ++i) {
    xh_put(scope->var_tbl, pic_symbol_name(pic, scope->vars[i]), 0);
  }

  state->scope = scope;
}

static void
pop_scope(analyze_state *state)
{
  analyze_scope *scope;

  scope = state->scope;
  xh_destroy(scope->var_tbl);
  pic_free(state->pic, scope->vars);

  scope = scope->up;
  pic_free(state->pic, state->scope);
  state->scope = scope;
}

static int
lookup_var(analyze_state *state, pic_sym sym)
{
  analyze_scope *scope = state->scope;
  struct xh_entry *e;
  int depth = 0;
  const char *key = pic_symbol_name(state->pic, sym);

 enter:

  e = xh_get(scope->var_tbl, key);
  if (e) {
    if (depth > 0) {            /* mark dirty */
      xh_put(scope->var_tbl, key, 1);
    }
    return depth;
  }
  if (scope->up) {
    scope = scope->up;
    ++depth;
    goto enter;
  }
  return -1;
}

static void
define_var(analyze_state *state, pic_sym sym)
{
  pic_state *pic = state->pic;
  analyze_scope *scope = state->scope;
  const char *name = pic_symbol_name(pic, sym);

  xh_put(state->scope->var_tbl, name, 0);

  scope->localc++;
  scope->vars = (pic_sym *)pic_realloc(pic, scope->vars, sizeof(pic_sym) * (scope->argc + scope->localc));
  scope->vars[scope->argc + scope->localc - 1] = sym;
}

static pic_value
new_ref(analyze_state *state, int depth, pic_sym sym)
{
  return pic_list(state->pic, 3,
                  pic_symbol_value(state->sREF),
                  pic_int_value(depth),
                  pic_symbol_value(sym));
}

static pic_value analyze_node(analyze_state *, pic_value, bool);
static pic_value analyze_call(analyze_state *, pic_value, bool);
static pic_value analyze_lambda(analyze_state *, pic_value);

static pic_value
analyze(analyze_state *state, pic_value obj, bool tailpos)
{
  pic_state *pic = state->pic;
  int ai = pic_gc_arena_preserve(pic);
  pic_value res;
  pic_sym tag;

  res = analyze_node(state, obj, tailpos);

  tag = pic_sym(pic_car(pic, res));
  if (tailpos) {
    if (tag == pic->sIF || tag == pic->sBEGIN || tag == state->sTAILCALL) {
      /* pass through */
    }
    else {
      res = pic_list(pic, 2, pic_symbol_value(state->sRETURN), res);
    }
  }

  pic_gc_arena_restore(pic, ai);
  pic_gc_protect(pic, res);
  return res;
}<commit_msg>duplicate OP_RET<commit_after>/**
 * See Copyright Notice in picrin.h
 */

#include <stdio.h>
#include <assert.h>

#include "picrin.h"
#include "picrin/pair.h"
#include "picrin/irep.h"
#include "picrin/proc.h"
#include "picrin/lib.h"
#include "picrin/macro.h"
#include "xhash/xhash.h"

#if PIC_NONE_IS_FALSE
# define OP_PUSHNONE OP_PUSHFALSE
#else
# error enable PIC_NONE_IS_FALSE
#endif

static pic_sym *
analyze_args(pic_state *pic, pic_value args, bool *varg, int *argc, int *localc)
{
  pic_sym *syms = (pic_sym *)pic_alloc(pic, sizeof(pic_sym));
  int i = 1, l = 0;
  pic_value v;

  *varg = false;
  for (v = args; pic_pair_p(v); v = pic_cdr(pic, v)) {
    pic_value sym;

    sym = pic_car(pic, v);
    if (! pic_sym_p(sym)) {
      pic_free(pic, syms);
      return NULL;
    }
    syms = (pic_sym *)pic_realloc(pic, syms, sizeof(pic_sym) * (i + 1));
    syms[i] = pic_sym(sym);
    i++;
  }
  if (pic_nil_p(v)) {
    /* pass */
  }
  else if (pic_sym_p(v)) {
    *varg = true;
    syms = (pic_sym *)pic_realloc(pic, syms, sizeof(pic_sym) * (i + 1));
    syms[i] = pic_sym(v);
    l++;
  }
  else {
    pic_free(pic, syms);
    return NULL;
  }
  *argc = i;
  *localc = l;

  return syms;
}

static bool
valid_formal(pic_state *pic, pic_value formal)
{
  bool varg;
  int argc, localc;
  pic_sym *syms;

  syms = analyze_args(pic, formal, &varg, &argc, &localc);
  if (syms == NULL) {
    return false;
  }
  else {
    pic_free(pic, syms);
    return true;
  }
}

typedef struct analyze_scope {
  /* rest args variable is counted by localc */
  bool varg;
  int argc, localc;
  /* if variable v is captured, then xh_get(var_tbl, v) == 1 */
  struct xhash *var_tbl;
  pic_sym *vars;

  struct analyze_scope *up;
} analyze_scope;

typedef struct analyze_state {
  pic_state *pic;
  analyze_scope *scope;
  pic_sym rCONS, rCAR, rCDR, rNILP;
  pic_sym rADD, rSUB, rMUL, rDIV;
  pic_sym rEQ, rLT, rLE, rGT, rGE, rNOT;
  pic_sym sCALL, sTAILCALL, sREF, sRETURN;
} analyze_state;

static void push_scope(analyze_state *, pic_value);
static void pop_scope(analyze_state *);

#define register_symbol(pic, state, slot, name) do {    \
    state->slot = pic_intern_cstr(pic, name);           \
  } while (0)

#define register_renamed_symbol(pic, state, slot, lib, name) do {       \
    struct xh_entry *e;                                                 \
    if (! (e = xh_get(lib->senv->tbl, name)))                           \
      pic_error(pic, "internal error! native VM procedure not found");  \
    state->slot = e->val;                                               \
  } while (0)

static analyze_state *
new_analyze_state(pic_state *pic)
{
  analyze_state *state;
  struct xhash *global_tbl;
  struct xh_iter it;
  struct pic_lib *stdlib;

  state = (analyze_state *)pic_alloc(pic, sizeof(analyze_state));
  state->pic = pic;
  state->scope = NULL;

  stdlib = pic_find_library(pic, pic_parse(pic, "(scheme base)"));

  /* native VM procedures */
  register_renamed_symbol(pic, state, rCONS, stdlib, "cons");
  register_renamed_symbol(pic, state, rCAR, stdlib, "car");
  register_renamed_symbol(pic, state, rCDR, stdlib, "cdr");
  register_renamed_symbol(pic, state, rNILP, stdlib, "null?");
  register_renamed_symbol(pic, state, rADD, stdlib, "+");
  register_renamed_symbol(pic, state, rSUB, stdlib, "-");
  register_renamed_symbol(pic, state, rMUL, stdlib, "*");
  register_renamed_symbol(pic, state, rDIV, stdlib, "/");
  register_renamed_symbol(pic, state, rEQ, stdlib, "=");
  register_renamed_symbol(pic, state, rLT, stdlib, "<");
  register_renamed_symbol(pic, state, rLE, stdlib, "<=");
  register_renamed_symbol(pic, state, rGT, stdlib, ">");
  register_renamed_symbol(pic, state, rGE, stdlib, ">=");
  register_renamed_symbol(pic, state, rNOT, stdlib, "not");

  register_symbol(pic, state, sCALL, "call");
  register_symbol(pic, state, sTAILCALL, "tail-call");
  register_symbol(pic, state, sREF, "ref");
  register_symbol(pic, state, sRETURN, "return");

  /* push initial scope */
  push_scope(state, pic_nil_value());

  global_tbl = pic->global_tbl;
  for (xh_begin(global_tbl, &it); ! xh_isend(&it); xh_next(&it)) {
    xh_put(state->scope->var_tbl, it.e->key, 0);
  }

  return state;
}

static void
destroy_analyze_state(analyze_state *state)
{
  pop_scope(state);
  pic_free(state->pic, state);
}

static void
push_scope(analyze_state *state, pic_value args)
{
  pic_state *pic = state->pic;
  analyze_scope *scope;
  int i;

  scope = (analyze_scope *)pic_alloc(pic, sizeof(analyze_scope));
  scope->up = state->scope;
  scope->var_tbl = xh_new();
  scope->varg = false;
  scope->vars = analyze_args(pic, args, &scope->varg, &scope->argc, &scope->localc);

  if (scope->vars == NULL) {
    pic_error(pic, "logic flaw");
  }

  for (i = 1; i < scope->argc + scope->localc; ++i) {
    xh_put(scope->var_tbl, pic_symbol_name(pic, scope->vars[i]), 0);
  }

  state->scope = scope;
}

static void
pop_scope(analyze_state *state)
{
  analyze_scope *scope;

  scope = state->scope;
  xh_destroy(scope->var_tbl);
  pic_free(state->pic, scope->vars);

  scope = scope->up;
  pic_free(state->pic, state->scope);
  state->scope = scope;
}

static int
lookup_var(analyze_state *state, pic_sym sym)
{
  analyze_scope *scope = state->scope;
  struct xh_entry *e;
  int depth = 0;
  const char *key = pic_symbol_name(state->pic, sym);

 enter:

  e = xh_get(scope->var_tbl, key);
  if (e) {
    if (depth > 0) {            /* mark dirty */
      xh_put(scope->var_tbl, key, 1);
    }
    return depth;
  }
  if (scope->up) {
    scope = scope->up;
    ++depth;
    goto enter;
  }
  return -1;
}

static void
define_var(analyze_state *state, pic_sym sym)
{
  pic_state *pic = state->pic;
  analyze_scope *scope = state->scope;
  const char *name = pic_symbol_name(pic, sym);

  xh_put(state->scope->var_tbl, name, 0);

  scope->localc++;
  scope->vars = (pic_sym *)pic_realloc(pic, scope->vars, sizeof(pic_sym) * (scope->argc + scope->localc));
  scope->vars[scope->argc + scope->localc - 1] = sym;
}

static pic_value
new_ref(analyze_state *state, int depth, pic_sym sym)
{
  return pic_list(state->pic, 3,
                  pic_symbol_value(state->sREF),
                  pic_int_value(depth),
                  pic_symbol_value(sym));
}

static pic_value analyze_node(analyze_state *, pic_value, bool);
static pic_value analyze_call(analyze_state *, pic_value, bool);
static pic_value analyze_lambda(analyze_state *, pic_value);

static pic_value
analyze(analyze_state *state, pic_value obj, bool tailpos)
{
  pic_state *pic = state->pic;
  int ai = pic_gc_arena_preserve(pic);
  pic_value res;
  pic_sym tag;

  res = analyze_node(state, obj, tailpos);

  tag = pic_sym(pic_car(pic, res));
  if (tailpos) {
    if (tag == pic->sIF || tag == pic->sBEGIN || tag == state->sTAILCALL || tag == state->sRETURN) {
      /* pass through */
    }
    else {
      res = pic_list(pic, 2, pic_symbol_value(state->sRETURN), res);
    }
  }

  pic_gc_arena_restore(pic, ai);
  pic_gc_protect(pic, res);
  return res;
}
{'fraction_non_alphanumeric': 0.14913031080695752, 'fraction_numerical': 0.0025662959794696323, 'mean_word_length': 3.5240245082231536, 'pattern_counts': {'":': 0, '<': 13, '<?xml version=': 0, '>': 134, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 8, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '599896', 'n_tokens_mistral': 5446, 'n_tokens_neox': 5350, 'n_words': 1209}