initial vector support

include/picrin.h

@@ -83,6 +83,9 @@ const char *pic_symbol_name(pic_state *, pic_sym);
 pic_value pic_str_new(pic_state *, const char *, size_t);
 pic_value pic_str_new_cstr(pic_state *, const char *);
 
+struct pic_vector *pic_vec_new(pic_state *, size_t);
+struct pic_vector *pic_vec_new_from_list(pic_state *, pic_value);
+
 bool pic_parse_file(pic_state *, FILE *file, pic_value *);
 bool pic_parse_cstr(pic_state *, const char *, pic_value *);
 

include/picrin/value.h

@@ -36,9 +36,10 @@ enum pic_tt {
   PIC_TT_UNDEF,
   /* heap */
   PIC_TT_PAIR,
+  PIC_TT_STRING,
+  PIC_TT_VECTOR,
   PIC_TT_PROC,
   PIC_TT_PORT,
-  PIC_TT_STRING,
   PIC_TT_ENV
 };
 
@@ -61,12 +62,19 @@ struct pic_string {
   size_t len;
 };
 
+struct pic_vector {
+  PIC_OBJECT_HEADER
+  pic_value *data;
+  size_t len;
+};
+
 struct pic_proc;
 struct pic_port;
 
 #define pic_obj_ptr(o) ((struct pic_object *)(o).u.data)
 #define pic_pair_ptr(o) ((struct pic_pair *)(o).u.data)
 #define pic_str_ptr(o) ((struct pic_string *)(o).u.data)
+#define pic_vec_ptr(o) ((struct pic_vector *)(o).u.data)
 
 enum pic_tt pic_type(pic_value);
 
@@ -93,5 +101,6 @@ pic_value pic_symbol_value(pic_sym);
 #define pic_symbol_p(v) ((v).type == PIC_VTYPE_SYMBOL)
 #define pic_pair_p(v) (pic_type(v) == PIC_TT_PAIR)
 #define pic_str_p(v) (pic_type(v) == PIC_TT_STRING)
+#define pic_vec_p(v) (pic_type(v) == PIC_TT_VECTOR)
 
 #endif

src/codegen.c

@@ -494,7 +494,8 @@ codegen(codegen_state *state, pic_value obj)
     irep->clen++;
     break;
   }
-  case PIC_TT_STRING: {
+  case PIC_TT_STRING:
+  case PIC_TT_VECTOR: {
     int pidx;
     pidx = pic->plen++;
     pic->pool[pidx] = obj;

src/gc.c

@@ -176,6 +176,14 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     break;
   }
   case PIC_TT_STRING: {
+    break;
+  }
+  case PIC_TT_VECTOR: {
+    int i;
+    for (i = 0; i < ((struct pic_vector *)obj)->len; ++i) {
+      gc_mark(pic, ((struct pic_vector *)obj)->data[i]);
+    }
+    break;
   }
   case PIC_TT_NIL:
   case PIC_TT_BOOL:
@@ -263,6 +271,10 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
   case PIC_TT_PROC: {
     break;
   }
+  case PIC_TT_VECTOR: {
+    pic_free(pic, ((struct pic_vector *)obj)->data);
+    break;
+  }
   case PIC_TT_STRING: {
     pic_free(pic, (void*)((struct pic_string *)obj)->str);
     break;

src/parse.y

@@ -37,7 +37,7 @@ void yylex_destroy();
   pic_value datum;
 }
 
-%token tLPAREN tRPAREN tDOT
+%token tLPAREN tRPAREN tDOT tVPAREN
 %token tQUOTE tQUASIQUOTE tUNQUOTE tUNQUOTE_SPLICING
 %token <i> tINT tBOOLEAN
 %token <f> tFLOAT
@@ -45,7 +45,7 @@ void yylex_destroy();
 
 %type <datum> program_data
 %type <datum> datum simple_datum compound_datum abbrev
-%type <datum> list list_data
+%type <datum> list list_data vector vector_data
 
 %%
 
@@ -116,6 +116,7 @@ simple_datum
 
 compound_datum
 	: list
+	| vector
 	| abbrev
 ;
 
@@ -141,6 +142,24 @@ list_data
 	}
 ;
 
+vector
+	: tVPAREN vector_data tRPAREN
+	{
+	  $$ = pic_obj_value(pic_vec_new_from_list(p->pic, $2));
+	}
+;
+
+vector_data
+	: /* none */
+	{
+	  $$ = pic_nil_value();
+	}
+	| datum vector_data
+	{
+	  $$ = pic_cons(p->pic, $1, $2);
+	}
+;
+
 abbrev
 	: tQUOTE datum
 	{
@@ -162,6 +181,7 @@ abbrev
 
 incomplete_datum
 	: tLPAREN incomplete_data
+	| tVPAREN incomplete_data
 	| incomplete_abbrev
 ;
 

src/port.c

@@ -11,6 +11,8 @@ static void write_str(pic_state *pic, struct pic_string *str);
 static void
 write(pic_state *pic, pic_value obj)
 {
+  int i;
+
   switch (pic_type(obj)) {
   case PIC_TT_NIL:
     printf("()");
@@ -52,6 +54,16 @@ write(pic_state *pic, pic_value obj)
     write_str(pic, pic_str_ptr(obj));
     printf("\"");
     break;
+  case PIC_TT_VECTOR:
+    printf("#(");
+    for (i = 0; i < pic_vec_ptr(obj)->len; ++i) {
+      write(pic, pic_vec_ptr(obj)->data[i]);
+      if (i + 1 < pic_vec_ptr(obj)->len) {
+	printf(" ");
+      }
+    }
+    printf(")");
+    break;
   case PIC_TT_ENV:
     pic_abort(pic, "logic flaw");
   }

src/scan.l

@@ -41,6 +41,7 @@ infnan		"+inf.0"|"-inf.0"|"+nan.0"|"-nan.0"
 "."		return tDOT;
 "("		return tLPAREN;
 ")"		return tRPAREN;
+"#("		return tVPAREN;
 "'"		return tQUOTE;
 "`"		return tQUASIQUOTE;
 ","		return tUNQUOTE;