initial bytevector support

include/picrin/blob.h

@@ -0,0 +1,15 @@
+#ifndef BLOB_H__
+#define BLOB_H__
+
+struct pic_blob {
+  PIC_OBJECT_HEADER
+  char *data;
+  int len;
+};
+
+#define pic_blob_p(v) (pic_type(v) == PIC_TT_BLOB)
+#define pic_blob_ptr(v) ((struct pic_blob *)(v).u.data)
+
+struct pic_blob *pic_blob_new(pic_state *, char *, int len);
+
+#endif

include/picrin/value.h

@@ -41,6 +41,7 @@ enum pic_tt {
   PIC_TT_PAIR,
   PIC_TT_STRING,
   PIC_TT_VECTOR,
+  PIC_TT_BLOB,
   PIC_TT_PROC,
   PIC_TT_PORT,
   PIC_TT_ENV
@@ -73,6 +74,7 @@ struct pic_vector {
 
 struct pic_proc;
 struct pic_port;
+struct pic_blob;
 
 #define pic_obj_ptr(o) ((struct pic_object *)(o).u.data)
 #define pic_pair_ptr(o) ((struct pic_pair *)(o).u.data)

src/blob.c

@@ -0,0 +1,15 @@
+#include <string.h>
+
+#include "picrin.h"
+#include "picrin/blob.h"
+
+struct pic_blob *
+pic_blob_new(pic_state *pic, char *dat, int len)
+{
+  struct pic_blob *bv;
+
+  bv = (struct pic_blob *)pic_obj_alloc(pic, sizeof(struct pic_blob), PIC_TT_BLOB);
+  bv->data = strndup(dat, len);
+  bv->len = len;
+  return bv;
+}

src/codegen.c

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

src/expand.c

@@ -134,7 +134,8 @@ expand(pic_state *pic, pic_value obj, struct syntactic_env *env)
   case PIC_TT_CHAR:
   case PIC_TT_EOF:
   case PIC_TT_STRING:
-  case PIC_TT_VECTOR: {
+  case PIC_TT_VECTOR:
+  case PIC_TT_BLOB: {
     return obj;
   }
   case PIC_TT_PROC:

src/gc.c

@@ -5,6 +5,7 @@
 #include "picrin/irep.h"
 #include "picrin/proc.h"
 #include "picrin/port.h"
+#include "picrin/blob.h"
 
 #if GC_DEBUG
 # include <stdio.h>
@@ -187,6 +188,9 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     }
     break;
   }
+  case PIC_TT_BLOB: {
+    break;
+  }
   case PIC_TT_NIL:
   case PIC_TT_BOOL:
   case PIC_TT_FLOAT:
@@ -285,6 +289,10 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
     pic_free(pic, ((struct pic_vector *)obj)->data);
     break;
   }
+  case PIC_TT_BLOB: {
+    pic_free(pic, ((struct pic_blob *)obj)->data);
+    break;
+  }
   case PIC_TT_STRING: {
     pic_free(pic, (void*)((struct pic_string *)obj)->str);
     break;

src/parse.y

@@ -4,6 +4,7 @@
 
 #include "picrin.h"
 #include "picrin/pair.h"
+#include "picrin/blob.h"
 
 #define YYERROR_VERBOSE 1
 
@@ -35,6 +36,10 @@ void yylex_destroy();
   double f;
   char *cstr;
   char c;
+  struct {
+    char *dat;
+    int len, capa;
+  } blob;
   pic_value datum;
 }
 
@@ -44,6 +49,7 @@ void yylex_destroy();
 %token <f> tFLOAT
 %token <cstr> tSYMBOL tSTRING
 %token <c> tCHAR
+%token <blob> tBYTEVECTOR
 
 %type <datum> program_data
 %type <datum> datum simple_datum compound_datum abbrev
@@ -111,6 +117,11 @@ simple_datum
 	{
 	  $$ = pic_char_value($1);
 	}
+	| tBYTEVECTOR
+	{
+	  $$ = pic_obj_value(pic_blob_new(p->pic, $1.dat, $1.len));
+	  free($1.dat);
+	}
 ;
 
 compound_datum

src/port.c

@@ -4,6 +4,7 @@
 #include "picrin.h"
 #include "picrin/proc.h"
 #include "picrin/port.h"
+#include "picrin/blob.h"
 
 static void write_pair(pic_state *pic, struct pic_pair *pair);
 static void write_str(pic_state *pic, struct pic_string *str);
@@ -67,6 +68,16 @@ write(pic_state *pic, pic_value obj)
     }
     printf(")");
     break;
+  case PIC_TT_BLOB:
+    printf("#u8(");
+    for (i = 0; i < pic_blob_ptr(obj)->len; ++i) {
+      printf("%d", pic_blob_ptr(obj)->data[i]);
+      if (i + 1 < pic_blob_ptr(obj)->len) {
+	printf(" ");
+      }
+    }
+    printf(")");
+    break;
   case PIC_TT_ENV:
     printf("#<env %p>", pic_env_ptr(obj));
     break;

src/scan.l

@@ -33,6 +33,9 @@ infnan		"+inf.0"|"-inf.0"|"+nan.0"|"-nan.0"
   /* string */
 %x STRING
 
+  /* bytevector */
+%x BYTEVECTOR
+
 %%
 
 [ \t\n\r]	/* skip whitespace */
@@ -83,6 +86,28 @@ infnan		"+inf.0"|"-inf.0"|"+nan.0"|"-nan.0"
   return tCHAR;
 }
 
+"#u8("		{
+  BEGIN(BYTEVECTOR);
+  yylvalp->blob.len = 0;
+  yylvalp->blob.capa = 10;
+  yylvalp->blob.dat = calloc(10, 1);
+}
+<BYTEVECTOR>[ \r\n\t]
+<BYTEVECTOR>{uinteger}	{
+  int i = atoi(yytext);
+  if (0 > i || i > 255)
+    REJECT;
+  yylvalp->blob.dat[yylvalp->blob.len++] = (char)i;
+  if (yylvalp->blob.len > yylvalp->blob.capa) {
+    yylvalp->blob.capa *= 2;
+    yylvalp->blob.dat = realloc(yylvalp->blob.dat, yylvalp->blob.capa);
+  }
+}
+<BYTEVECTOR>")"	{
+  BEGIN(INITIAL);
+  return tBYTEVECTOR;
+}
+
 %%
 
 int