Beispiel #1
0
// returns NULL if not done yet
Obj *bytecode_eval_internal(Process *process, Obj *bytecodeObj, int steps) {
  Obj *literal, *function, *lookup, *result, *bindings, *let_env, *binding;
  int arg_count, i, bindings_index, body_index;
  
  for(int step = 0; step < steps; step++) {

    if(eval_error) {
      return nil;
    }
    
    Obj **literals_array = process->frames[process->frame].bytecodeObj->bytecode_literals->array;
    char *bytecode = process->frames[process->frame].bytecodeObj->bytecode;
    int p = process->frames[process->frame].p;
    char c = bytecode[p];
    
    //printf("frame = %d, c = %c\n", frame, c);
    
    switch(c) {
    case 'l':
      i = bytecode[p + 1] - 65;
      literal = literals_array[i];
      //printf("Pushing literal "); obj_print_cout(literal); printf("\n");
      stack_push(process, literal);
      process->frames[process->frame].p += 2;
      break;
    case 'd':
      i = bytecode[p + 1] - 65;
      literal = literals_array[i];
      result = env_extend(process->global_env, literal, stack_pop(process));
      stack_push(process, result->cdr);
      process->frames[process->frame].p += 2;
      break;
    case 'n':
      if(is_true(stack_pop(process))) {
        stack_push(process, lisp_false);
      } else {
        stack_push(process, lisp_true);
      }
      process->frames[process->frame].p += 1;
      break;
    case 'r':
      i = bytecode[p + 1] - 65;
      literal = literals_array[i];
      binding = env_lookup_binding(process, process->frames[process->frame].env, literal);
      if(binding->car) {
        //printf("binding: %s\n", obj_to_string(process, binding)->s);
        binding->cdr = stack_pop(process);
        stack_push(process, binding->cdr);
      } else {
        eval_error = obj_new_string("reset! can't find variable to reset: ");
        obj_string_mut_append(eval_error, obj_to_string(process, literal)->s);
        return nil;
      }      
      process->frames[process->frame].p += 2;
      break;
    case 't':
      //printf("entering let\n");
      //shadow_stack_push(process, let_env);

      bindings_index = bytecode[p + 1] - 65;
      body_index = bytecode[p + 2] - 65;
      
      bindings = literals_array[bindings_index];
      //printf("bindings: %s\n", obj_to_string(process, bindings)->s);

      let_env = obj_new_environment(process->frames[process->frame].env);
      for(int i = 0; i < bindings->count; i++) {
        env_extend(let_env, bindings->array[i], stack_pop(process));
      }

      process->frames[process->frame].p += 3;
    
      process->frames[process->frame + 1].p = 0;
      process->frames[process->frame + 1].bytecodeObj = literals_array[body_index];
      process->frames[process->frame + 1].env = let_env;
      process->frame++;

      //printf("will now execute: %s\n", obj_to_string(process, process->frames[process->frame].bytecodeObj)->s);

      break;
    case 'y':
      i = bytecode[p + 1] - 65;
      literal = literals_array[i];
      //printf("Looking up literal "); obj_print_cout(literal); printf("\n");
      lookup = env_lookup(process, process->frames[process->frame].env, literal);
      if(!lookup) {
        set_error_return_nil("Failed to lookup ", literal);
      }
      stack_push(process, lookup);
      process->frames[process->frame].p += 2;
      break;
    case 'i':
      i = bytecode[p + 1] - 65;
      if(is_true(stack_pop(process))) {
        process->frames[process->frame].p = 0;
        process->frames[process->frame].bytecodeObj = literals_array[i];
        process->frames[process->frame].env = process->frames[process->frame - 1].env;
      }
      else {
        process->frames[process->frame].p = 0;
        process->frames[process->frame].bytecodeObj = literals_array[i + 1];
        process->frames[process->frame].env = process->frames[process->frame - 1].env;
      }
      break;
    case 'c':
      function = stack_pop(process);
      arg_count = bytecode[p + 1] - 65;
      Obj **args = NULL;
      if(arg_count > 0) {
        args = malloc(sizeof(Obj*) * arg_count);
      }
      for(int i = 0; i < arg_count; i++) {
        Obj *arg = stack_pop(process);
        args[arg_count - i - 1] = arg;
        //shadow_stack_push(process, arg);
      }
      process->frames[process->frame].p += 2;

      if(function->tag == 'P') {
        stack_push(process, function->primop((struct Process*)process, args, arg_count));
      }
      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 == 'L') {
        Obj *calling_env = obj_new_environment(function->env);
        //printf("arg_count = %d\n", arg_count);
        env_extend_with_args(process, calling_env, function, arg_count, args, true);
        process->frame++;
        process->frames[process->frame].p = 0;
        if(function->body->tag != 'X') {
          set_error_return_nil("The body of the lambda must be bytecode, ", function);
        }
        process->frames[process->frame].bytecodeObj = function->body;
        process->frames[process->frame].env = calling_env;
        //printf("Pushing new stack frame with bytecode '%s'\n", process->frames[process->frame].bytecode); // and env %s\n", process->frames[process->frame].bytecode, obj_to_string(process, calling_env)->s);
      }
      else {
        printf("Can't handle other calling methods yet %c\n", function->tag);
        obj_print_cout(function);
        return nil;
      }      
      break;
    case 'q':
      process->frame--;
      if(process->frame < 0) {
        goto done;
      }
      break;
    default:
      printf("Unhandled instruction: %c\n", c);
      exit(-1);
    }
  }

 done:;
  return stack_pop(process);
}
Beispiel #2
0
void apply(Process *process, Obj *function, Obj **args, int arg_count) {
  if(function->tag == 'L') {

//printf("Calling lambda "); obj_print_cout(function); printf(" with params: "); obj_print_cout(function->params); printf("\n");
//printf("Applying %s with arg count %d\n", obj_to_string(process, function)->s, arg_count);

#if BYTECODE_EVAL

    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("calling_env: %s\n", obj_to_string(process, calling_env)->s);

    shadow_stack_push(process, function);
    shadow_stack_push(process, calling_env);

    /* printf("before\n"); */
    /* shadow_stack_print(process); */

    Obj *result = bytecode_sub_eval_internal(process, calling_env, function->body);

    if(eval_error) {
      return;
    }
    assert(result);

    //printf("result = %s\n", obj_to_string(process, result)->s);
    stack_push(process, result); // put it back on stack (TODO: fix this unnecessary work?)

    /* printf("after\n"); */
    /* shadow_stack_print(process); */

    Obj *pop1 = shadow_stack_pop(process);
    Obj *pop2 = shadow_stack_pop(process);
    assert(pop1 == calling_env);
    assert(pop2 == function);

#else

    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);

    if(function->body->tag == 'X') {
      eval_error = obj_new_string("Can't apply lambda with bytecode body.");
    }
    else {
      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);
#endif
  }
  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");
      shadow_stack_push(process, function_call_symbol);

      Obj **copied_args = malloc(sizeof(Obj *) * arg_count);
      for(int i = 0; i < arg_count; i++) {
        copied_args[i] = obj_copy(process, args[i]);
        if(args[i]->meta) {
          copied_args[i]->meta = obj_copy(process, args[i]->meta);
        }
      }

      Obj *carp_array = obj_new_array(arg_count);
      carp_array->array = copied_args;

      Obj *call_to_concretize_struct = obj_list(function_call_symbol,
                                                function,
                                                carp_array);

      shadow_stack_push(process, call_to_concretize_struct);
      eval_internal(process, process->global_env, call_to_concretize_struct);

      shadow_stack_pop(process);
      shadow_stack_pop(process);
    }
    else {
      call_struct_constructor(process, function, args, arg_count);
    }
  }
  else {
    set_error("Can't call non-function: ", function);
  }
}