native/vector.c

   1 #include "factor.h"
   2
   3 VECTOR* vector(FIXNUM capacity)
   4 {
   5         VECTOR* vector = allot_object(VECTOR_TYPE,sizeof(VECTOR));
   6         vector->top = 0;
   7         vector->array = array(capacity,F);
   8         return vector;
   9 }
  10
  11 void primitive_vectorp(void)
  12 {
  13         check_non_empty(env.dt);
  14         env.dt = tag_boolean(typep(VECTOR_TYPE,env.dt));
  15 }
  16
  17 void primitive_vector(void)
  18 {
  19         env.dt = tag_object(vector(to_fixnum(env.dt)));
  20 }
  21
  22 void primitive_vector_length(void)
  23 {
  24         env.dt = tag_fixnum(untag_vector(env.dt)->top);
  25 }
  26
  27 void primitive_set_vector_length(void)
  28 {
  29         VECTOR* vector = untag_vector(env.dt);
  30         FIXNUM length = to_fixnum(dpop());
  31         vector->top = length;
  32         if(length < 0)
  33                 range_error(tag_object(vector),length,vector->top);
  34         else if(length > vector->array->capacity)
  35                 vector->array = grow_array(vector->array,length,F);
  36         env.dt = dpop(); /* don't forget this! */
  37 }
  38
  39 void primitive_vector_nth(void)
  40 {
  41         VECTOR* vector = untag_vector(env.dt);
  42         CELL index = to_fixnum(dpop());
  43
  44         if(index < 0 || index >= vector->top)
  45                 range_error(tag_object(vector),index,vector->top);
  46         env.dt = array_nth(vector->array,index);
  47 }
  48
  49 void vector_ensure_capacity(VECTOR* vector, CELL index)
  50 {
  51         ARRAY* array = vector->array;
  52         CELL capacity = array->capacity;
  53         if(index >= capacity)
  54                 array = grow_array(array,index * 2 + 1,F);
  55         vector->top = index + 1;
  56         vector->array = array;
  57 }
  58
  59 void primitive_set_vector_nth(void)
  60 {
  61         VECTOR* vector = untag_vector(env.dt);
  62         FIXNUM index = to_fixnum(dpop());
  63         CELL value = dpop();
  64         check_non_empty(value);
  65
  66         if(index < 0)
  67                 range_error(tag_object(vector),index,vector->top);
  68         else if(index >= vector->top)
  69                 vector_ensure_capacity(vector,index);
  70
  71         /* the following does not check bounds! */
  72         set_array_nth(vector->array,index,value);
  73
  74         env.dt = dpop(); /* don't forget this! */
  75 }
  76
  77 void fixup_vector(VECTOR* vector)
  78 {
  79         vector->array = (ARRAY*)((CELL)vector->array
  80                 + (active->base - relocation_base));
  81 }
  82
  83 void collect_vector(VECTOR* vector)
  84 {
  85         vector->array = copy_array(vector->array);
  86 }