<commit_before>#include "eval.h"
#include "env.h"
#include "assertions.h"
#include "reader.h"
#include "gc.h"
#include "primops.h"
#include "obj.h"
#include "obj_conversions.h"
#include "constants.h"
#include "../shared/types.h"
#include "match.h"

#define LOG_EVAL 0
#define SHOW_MACRO_EXPANSION 0
#define LOG_FUNC_APPLICATION 0
#define GC_COLLECT_AFTER_EACH_FORM 0

bool in_macro_expansion = false;

void call_struct_constructor(Process *process, Obj *function, Obj **args, int arg_count) {
  // Evaluation of a struct-definition (a dictionary) in function position (which means that it is used as a constructor)
  Obj *name_obj = env_lookup(process, function, obj_new_keyword("name"));
  assert_or_set_error(name_obj, "no key 'name' on struct definition: ", function);
  char *name = name_obj->s;

  Obj *struct_size_obj = env_lookup(process, function, obj_new_keyword("size"));
  assert_or_set_error(struct_size_obj, "no key 'size' on struct definition: ", function);
  int struct_size = struct_size_obj->i;

  Obj *struct_member_count_obj = env_lookup(process, function, obj_new_keyword("member-count"));
  assert_or_set_error(struct_member_count_obj, "no key 'member-count' on struct definition: ", function);
  int member_count = struct_member_count_obj->i;
    
  Obj *offsets_obj = env_lookup(process, function, obj_new_keyword("member-offsets"));
  assert_or_set_error(offsets_obj, "no key 'member-offsets' on struct definition: ", function);
  assert_or_set_error(offsets_obj->tag == 'A', "offsets must be an array: ", function);
  Obj **offsets = offsets_obj->array;
    
  Obj *member_types_obj = env_lookup(process, function, obj_new_keyword("member-types"));
  assert_or_set_error(member_types_obj, "no key 'member-types' on struct definition: ", function);
  assert_or_set_error(member_types_obj->tag == 'A', "member-types must be an array: ", function);
  Obj **member_types = member_types_obj->array;
   
  //printf("Will create a %s of size %d and member count %d.\n", name, size, member_count);
  void *p = malloc(struct_size);
  Obj *new_struct = obj_new_ptr(p);

  shadow_stack_push(process, new_struct);
    
  if(!new_struct->meta) {
    new_struct->meta = obj_new_environment(NULL);
  }
  env_assoc(process, new_struct->meta, obj_new_keyword("type"), obj_new_keyword(name));

  assert_or_set_error(!(arg_count < member_count), "Too few args to struct constructor: ", obj_new_string(name));
  assert_or_set_error(!(arg_count > member_count), "Too many args to struct constructor: ", obj_new_string(name));
    
  for(int i = 0; i < arg_count; i++) {
    Obj *member_type = member_types[i];
    int offset = offsets[i]->i;
    if(args[i]->tag == 'V') {
      assert_or_set_error(obj_eq(process, member_type, type_float), "Can't assign float to a member of type ", obj_to_string(process, member_type));
      float *fp = (float*)(((char*)new_struct->void_ptr) + offset);
      float f = args[i]->f32;
      //printf("Setting member %d at offset %d to %f.\n", i, offset, f);
      *fp = f;
    }
    else if(args[i]->tag == 'I') {
      assert_or_set_error(obj_eq(process, member_type, type_int), "Can't assign int to a member of type ", obj_to_string(process, member_type));
      int *xp = (int*)(((char*)new_struct->void_ptr) + offset);
      int x = args[i]->i;
      *xp = x;
    }
    else if(args[i]->tag == 'B') {
      assert_or_set_error(obj_eq(process, member_type, type_bool), "Can't assign bool to a member of type ", obj_to_string(process, member_type));
      bool *xp = (bool*)(((char*)new_struct->void_ptr) + offset);
      bool x = args[i]->boolean;
      *xp = x;
    }
    else if(args[i]->tag == 'Q') {
      assert_or_set_error(!obj_eq(process, member_type, type_char), "Can't assign char to a member of type ", obj_to_string(process, member_type));
      assert_or_set_error(!obj_eq(process, member_type, type_int), "Can't assign int to a member of type ", obj_to_string(process, member_type));
      assert_or_set_error(!obj_eq(process, member_type, type_float), "Can't assign float to a member of type ", obj_to_string(process, member_type));
      assert_or_set_error(!obj_eq(process, member_type, type_string), "Can't assign string to a member of type ", obj_to_string(process, member_type));
      void **vp = (void**)(((char*)new_struct->void_ptr) + offset);
      *vp = args[i]->void_ptr;
    }
    else if(args[i]->tag == 'S') {
      assert_or_set_error(obj_eq(process, member_type, type_string), "Can't assign int to a member of type ", obj_to_string(process, member_type));
      char **sp = (char**)(((char*)new_struct->void_ptr) + offset);
      *sp = strdup(args[i]->s); // must strdup or the struct will ref Obj's on the stack that will get gc:ed
    }
    else if(args[i]->tag == 'T') {
      assert_or_set_error(obj_eq(process, member_type, type_char), "Can't assign char to a member of type ", obj_to_string(process, member_type));
      char *cp = (char*)(((char*)new_struct->void_ptr) + offset);
      *cp = args[i]->character;
    }
    else if(args[i]->tag == 'A') {
      //assert_or_set_error(obj_eq(member_type, type_array), "Can't assign array to a member of type ", obj_to_string(member_type));

      // TODO: use this code for sending arrays to normal FFI functions too!!!
      // TODO: use the SAME code for sending data to FFI and struct constructors.
      // TODO: check that we send the expected type to the constructor
        
      Array *a = obj_array_to_carp_array(process, args[i]);
      if(!a) {
        return;
      }
        
      void **ap = (void**)(((char*)new_struct->void_ptr) + offset);
      *ap = a;
    }
    else {
      eval_error = obj_new_string("Can't set member ");
      char buffer[32];
      sprintf(buffer, "%d", i);
      obj_string_mut_append(eval_error, buffer);
      obj_string_mut_append(eval_error, " of struct ");
      obj_string_mut_append(eval_error, name);
      obj_string_mut_append(eval_error, " to ");
      obj_string_mut_append(eval_error, obj_to_string(process, args[i])->s);
      obj_string_mut_append(eval_error, " (unhandled type).");
      return;
    }
  }
  shadow_stack_pop(process); // pop new_struct
  stack_push(process, new_struct);
}

void apply(Process *process, Obj *function, Obj **args, int arg_count) {
  if(function->tag == 'L') {

    //printf("Calling function "); obj_print_cout(function); printf(" with params: "); obj_print_cout(function->params); printf("\n");
    
    Obj *calling_env = obj_new_environment(function->env);
    bool allow_rest_args = true;
    env_extend_with_args(process, calling_env, function, arg_count, args, allow_rest_args);
    //printf("Lambda env: %s\n", obj_to_string(calling_env)->s);

    shadow_stack_push(process, function);
    shadow_stack_push(process, calling_env);
    
    eval_internal(process, calling_env, function->body);
    if(eval_error) {
      return;
    }
    
    Obj *pop1 = shadow_stack_pop(process);
    Obj *pop2 = shadow_stack_pop(process);
    assert(pop1 == calling_env);
    assert(pop2 == function);
  }
  else if(function->tag == 'P') {   
    Obj *result = function->primop((struct Process*)process, args, arg_count);
    stack_push(process, result);
  }
  else if(function->tag == 'F') {
    call_foreign_function(process, function, args, arg_count);
  }
  else if(function->tag == 'K') {
    if(arg_count != 1) {
      eval_error = obj_new_string("Args to keyword lookup must be a single arg.");
    }
    else if(args[0]->tag != 'E') {
      eval_error = obj_new_string("Arg 0 to keyword lookup must be a dictionary: ");
      obj_string_mut_append(eval_error, obj_to_string(process, args[0])->s);
    }
    else {
      Obj *value = env_lookup(process, args[0], function);
      if(value) {
        stack_push(process, value);
      } else {
        eval_error = obj_new_string("Failed to lookup keyword '");
        obj_string_mut_append(eval_error, obj_to_string(process, function)->s);
        obj_string_mut_append(eval_error, "'");
        obj_string_mut_append(eval_error, " in \n");
        obj_string_mut_append(eval_error, obj_to_string(process, args[0])->s);
        obj_string_mut_append(eval_error, "\n");
      }
    }
  } 
  else if(function->tag == 'E' && obj_eq(process, env_lookup(process, function, obj_new_keyword("struct")), lisp_true)) {
    //printf("Calling struct: %s\n", obj_to_string(process, function)->s);
    if(obj_eq(process, env_lookup(process, function, obj_new_keyword("generic")), lisp_true)) {
      //printf("Calling generic struct constructor.\n");
      Obj *function_call_symbol = obj_new_symbol("dynamic-generic-constructor-call");

      Obj **copied_args = malloc(sizeof(Obj*) * arg_count);
      for(int i = 0; i < arg_count; i++) {
        copied_args[i] = obj_copy(args[i]);
        copied_args[i]->meta = obj_copy(args[i]->meta);
      }
      
      Obj *carp_array = obj_new_array(arg_count);
      carp_array->array = copied_args;<commit_msg>fixed error with meta<commit_after>#include "eval.h"
#include "env.h"
#include "assertions.h"
#include "reader.h"
#include "gc.h"
#include "primops.h"
#include "obj.h"
#include "obj_conversions.h"
#include "constants.h"
#include "../shared/types.h"
#include "match.h"

#define LOG_EVAL 0
#define SHOW_MACRO_EXPANSION 0
#define LOG_FUNC_APPLICATION 0
#define GC_COLLECT_AFTER_EACH_FORM 0

bool in_macro_expansion = false;

void call_struct_constructor(Process *process, Obj *function, Obj **args, int arg_count) {
  // Evaluation of a struct-definition (a dictionary) in function position (which means that it is used as a constructor)
  Obj *name_obj = env_lookup(process, function, obj_new_keyword("name"));
  assert_or_set_error(name_obj, "no key 'name' on struct definition: ", function);
  char *name = name_obj->s;

  Obj *struct_size_obj = env_lookup(process, function, obj_new_keyword("size"));
  assert_or_set_error(struct_size_obj, "no key 'size' on struct definition: ", function);
  int struct_size = struct_size_obj->i;

  Obj *struct_member_count_obj = env_lookup(process, function, obj_new_keyword("member-count"));
  assert_or_set_error(struct_member_count_obj, "no key 'member-count' on struct definition: ", function);
  int member_count = struct_member_count_obj->i;
    
  Obj *offsets_obj = env_lookup(process, function, obj_new_keyword("member-offsets"));
  assert_or_set_error(offsets_obj, "no key 'member-offsets' on struct definition: ", function);
  assert_or_set_error(offsets_obj->tag == 'A', "offsets must be an array: ", function);
  Obj **offsets = offsets_obj->array;
    
  Obj *member_types_obj = env_lookup(process, function, obj_new_keyword("member-types"));
  assert_or_set_error(member_types_obj, "no key 'member-types' on struct definition: ", function);
  assert_or_set_error(member_types_obj->tag == 'A', "member-types must be an array: ", function);
  Obj **member_types = member_types_obj->array;
   
  //printf("Will create a %s of size %d and member count %d.\n", name, size, member_count);
  void *p = malloc(struct_size);
  Obj *new_struct = obj_new_ptr(p);

  shadow_stack_push(process, new_struct);
    
  if(!new_struct->meta) {
    new_struct->meta = obj_new_environment(NULL);
  }
  env_assoc(process, new_struct->meta, obj_new_keyword("type"), obj_new_keyword(name));

  assert_or_set_error(!(arg_count < member_count), "Too few args to struct constructor: ", obj_new_string(name));
  assert_or_set_error(!(arg_count > member_count), "Too many args to struct constructor: ", obj_new_string(name));
    
  for(int i = 0; i < arg_count; i++) {
    Obj *member_type = member_types[i];
    int offset = offsets[i]->i;
    if(args[i]->tag == 'V') {
      assert_or_set_error(obj_eq(process, member_type, type_float), "Can't assign float to a member of type ", obj_to_string(process, member_type));
      float *fp = (float*)(((char*)new_struct->void_ptr) + offset);
      float f = args[i]->f32;
      //printf("Setting member %d at offset %d to %f.\n", i, offset, f);
      *fp = f;
    }
    else if(args[i]->tag == 'I') {
      assert_or_set_error(obj_eq(process, member_type, type_int), "Can't assign int to a member of type ", obj_to_string(process, member_type));
      int *xp = (int*)(((char*)new_struct->void_ptr) + offset);
      int x = args[i]->i;
      *xp = x;
    }
    else if(args[i]->tag == 'B') {
      assert_or_set_error(obj_eq(process, member_type, type_bool), "Can't assign bool to a member of type ", obj_to_string(process, member_type));
      bool *xp = (bool*)(((char*)new_struct->void_ptr) + offset);
      bool x = args[i]->boolean;
      *xp = x;
    }
    else if(args[i]->tag == 'Q') {
      assert_or_set_error(!obj_eq(process, member_type, type_char), "Can't assign char to a member of type ", obj_to_string(process, member_type));
      assert_or_set_error(!obj_eq(process, member_type, type_int), "Can't assign int to a member of type ", obj_to_string(process, member_type));
      assert_or_set_error(!obj_eq(process, member_type, type_float), "Can't assign float to a member of type ", obj_to_string(process, member_type));
      assert_or_set_error(!obj_eq(process, member_type, type_string), "Can't assign string to a member of type ", obj_to_string(process, member_type));
      void **vp = (void**)(((char*)new_struct->void_ptr) + offset);
      *vp = args[i]->void_ptr;
    }
    else if(args[i]->tag == 'S') {
      assert_or_set_error(obj_eq(process, member_type, type_string), "Can't assign int to a member of type ", obj_to_string(process, member_type));
      char **sp = (char**)(((char*)new_struct->void_ptr) + offset);
      *sp = strdup(args[i]->s); // must strdup or the struct will ref Obj's on the stack that will get gc:ed
    }
    else if(args[i]->tag == 'T') {
      assert_or_set_error(obj_eq(process, member_type, type_char), "Can't assign char to a member of type ", obj_to_string(process, member_type));
      char *cp = (char*)(((char*)new_struct->void_ptr) + offset);
      *cp = args[i]->character;
    }
    else if(args[i]->tag == 'A') {
      //assert_or_set_error(obj_eq(member_type, type_array), "Can't assign array to a member of type ", obj_to_string(member_type));

      // TODO: use this code for sending arrays to normal FFI functions too!!!
      // TODO: use the SAME code for sending data to FFI and struct constructors.
      // TODO: check that we send the expected type to the constructor
        
      Array *a = obj_array_to_carp_array(process, args[i]);
      if(!a) {
        return;
      }
        
      void **ap = (void**)(((char*)new_struct->void_ptr) + offset);
      *ap = a;
    }
    else {
      eval_error = obj_new_string("Can't set member ");
      char buffer[32];
      sprintf(buffer, "%d", i);
      obj_string_mut_append(eval_error, buffer);
      obj_string_mut_append(eval_error, " of struct ");
      obj_string_mut_append(eval_error, name);
      obj_string_mut_append(eval_error, " to ");
      obj_string_mut_append(eval_error, obj_to_string(process, args[i])->s);
      obj_string_mut_append(eval_error, " (unhandled type).");
      return;
    }
  }
  shadow_stack_pop(process); // pop new_struct
  stack_push(process, new_struct);
}

void apply(Process *process, Obj *function, Obj **args, int arg_count) {
  if(function->tag == 'L') {

    //printf("Calling function "); obj_print_cout(function); printf(" with params: "); obj_print_cout(function->params); printf("\n");
    
    Obj *calling_env = obj_new_environment(function->env);
    bool allow_rest_args = true;
    env_extend_with_args(process, calling_env, function, arg_count, args, allow_rest_args);
    //printf("Lambda env: %s\n", obj_to_string(calling_env)->s);

    shadow_stack_push(process, function);
    shadow_stack_push(process, calling_env);
    
    eval_internal(process, calling_env, function->body);
    if(eval_error) {
      return;
    }
    
    Obj *pop1 = shadow_stack_pop(process);
    Obj *pop2 = shadow_stack_pop(process);
    assert(pop1 == calling_env);
    assert(pop2 == function);
  }
  else if(function->tag == 'P') {   
    Obj *result = function->primop((struct Process*)process, args, arg_count);
    stack_push(process, result);
  }
  else if(function->tag == 'F') {
    call_foreign_function(process, function, args, arg_count);
  }
  else if(function->tag == 'K') {
    if(arg_count != 1) {
      eval_error = obj_new_string("Args to keyword lookup must be a single arg.");
    }
    else if(args[0]->tag != 'E') {
      eval_error = obj_new_string("Arg 0 to keyword lookup must be a dictionary: ");
      obj_string_mut_append(eval_error, obj_to_string(process, args[0])->s);
    }
    else {
      Obj *value = env_lookup(process, args[0], function);
      if(value) {
        stack_push(process, value);
      } else {
        eval_error = obj_new_string("Failed to lookup keyword '");
        obj_string_mut_append(eval_error, obj_to_string(process, function)->s);
        obj_string_mut_append(eval_error, "'");
        obj_string_mut_append(eval_error, " in \n");
        obj_string_mut_append(eval_error, obj_to_string(process, args[0])->s);
        obj_string_mut_append(eval_error, "\n");
      }
    }
  } 
  else if(function->tag == 'E' && obj_eq(process, env_lookup(process, function, obj_new_keyword("struct")), lisp_true)) {
    //printf("Calling struct: %s\n", obj_to_string(process, function)->s);
    if(obj_eq(process, env_lookup(process, function, obj_new_keyword("generic")), lisp_true)) {
      //printf("Calling generic struct constructor.\n");
      Obj *function_call_symbol = obj_new_symbol("dynamic-generic-constructor-call");

      Obj **copied_args = malloc(sizeof(Obj*) * arg_count);
      for(int i = 0; i < arg_count; i++) {
        copied_args[i] = obj_copy(args[i]);
        if(args[i]->meta) {
          copied_args[i]->meta = obj_copy(args[i]->meta);
        }
      }
      
      Obj *carp_array = obj_new_array(arg_count);
      carp_array->array = copied_args;
{'fraction_non_alphanumeric': 0.14312891674127126, 'fraction_numerical': 0.0022381378692927483, 'mean_word_length': 4.083333333333333, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 106, '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': '5160545', 'n_tokens_mistral': 6126, 'n_tokens_neox': 6032, 'n_words': 1385}