initial char support

include/picrin/irep.h

@@ -8,6 +8,7 @@ enum pic_opcode {
   OP_PUSHFALSE,
   OP_PUSHFLOAT,
   OP_PUSHINT,
+  OP_PUSHCHAR,
   OP_PUSHCONST,
   OP_GREF,
   OP_GSET,
@@ -40,6 +41,7 @@ struct pic_code {
   union {
     double f;
     int i;
+    char c;
     struct {
       short depth;
       short idx;

include/picrin/value.h

@@ -11,6 +11,7 @@ enum pic_vtype {
   PIC_VTYPE_FLOAT,
   PIC_VTYPE_INT,
   PIC_VTYPE_SYMBOL,
+  PIC_VTYPE_CHAR,
   PIC_VTYPE_EOF,
   PIC_VTYPE_HEAP
 };
@@ -22,6 +23,7 @@ typedef struct {
     double f;
     int i;
     pic_sym sym;
+    char c;
   } u;
 } pic_value;
 
@@ -32,6 +34,7 @@ enum pic_tt {
   PIC_TT_FLOAT,
   PIC_TT_INT,
   PIC_TT_SYMBOL,
+  PIC_TT_CHAR,
   PIC_TT_EOF,
   PIC_TT_UNDEF,
   /* heap */
@@ -88,10 +91,12 @@ pic_value pic_obj_value(void *);
 pic_value pic_float_value(double);
 pic_value pic_int_value(int);
 pic_value pic_symbol_value(pic_sym);
+pic_value pic_char_value(char c);
 
 #define pic_float(v) ((v).u.f)
 #define pic_int(v) ((v).u.i)
 #define pic_sym(v) ((v).u.sym)
+#define pic_char(v) ((v).u.c)
 
 #define pic_nil_p(v) ((v).type == PIC_VTYPE_NIL)
 #define pic_true_p(v) ((v).type == PIC_VTYPE_TRUE)
@@ -100,6 +105,7 @@ pic_value pic_symbol_value(pic_sym);
 #define pic_float_p(v) ((v).type == PIC_VTYPE_FLOAT)
 #define pic_int_p(v) ((v).type == PIC_VTYPE_INT)
 #define pic_symbol_p(v) ((v).type == PIC_VTYPE_SYMBOL)
+#define pic_char_p(v) ((v).type == PIC_VTYPE_CHAR)
 #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)

src/codegen.c

@@ -511,6 +511,12 @@ codegen(codegen_state *state, pic_value obj, bool tailpos)
     irep->clen++;
     break;
   }
+  case PIC_TT_CHAR: {
+    irep->code[irep->clen].insn = OP_PUSHCHAR;
+    irep->code[irep->clen].u.c = pic_char(obj);
+    irep->clen++;
+    break;
+  }
   case PIC_TT_STRING:
   case PIC_TT_VECTOR: {
     int pidx;
@@ -810,6 +816,9 @@ print_irep(pic_state *pic, struct pic_irep *irep)
     case OP_PUSHINT:
       printf("OP_PUSHINT\t%d\n", irep->code[i].u.i);
       break;
+    case OP_PUSHCHAR:
+      printf("OP_PUSHCHAR\t%c\n", irep->code[i].u.c);
+      break;
     case OP_PUSHCONST:
       printf("OP_PUSHCONST\t");
       pic_debug(pic, pic->pool[irep->code[i].u.i]);

src/expand.c

@@ -131,6 +131,7 @@ expand(pic_state *pic, pic_value obj, struct syntactic_env *env)
   case PIC_TT_BOOL:
   case PIC_TT_FLOAT:
   case PIC_TT_INT:
+  case PIC_TT_CHAR:
   case PIC_TT_EOF:
   case PIC_TT_STRING:
   case PIC_TT_VECTOR: {

src/gc.c

@@ -192,6 +192,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
   case PIC_TT_FLOAT:
   case PIC_TT_INT:
   case PIC_TT_SYMBOL:
+  case PIC_TT_CHAR:
   case PIC_TT_EOF:
   case PIC_TT_UNDEF:
     pic_abort(pic, "logic flaw");
@@ -300,6 +301,7 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
   case PIC_TT_FLOAT:
   case PIC_TT_INT:
   case PIC_TT_SYMBOL:
+  case PIC_TT_CHAR:
   case PIC_TT_EOF:
   case PIC_TT_UNDEF:
     pic_abort(pic, "logic flaw");

src/parse.y

@@ -34,6 +34,7 @@ void yylex_destroy();
   int i;
   double f;
   char *cstr;
+  char c;
   pic_value datum;
 }
 
@@ -42,6 +43,7 @@ void yylex_destroy();
 %token <i> tINT tBOOLEAN
 %token <f> tFLOAT
 %token <cstr> tSYMBOL tSTRING
+%token <c> tCHAR
 
 %type <datum> program_data
 %type <datum> datum simple_datum compound_datum abbrev
@@ -105,6 +107,10 @@ simple_datum
 	{
 	  $$ = pic_bool_value($1);
 	}
+	| tCHAR
+	{
+	  $$ = pic_char_value($1);
+	}
 ;
 
 compound_datum

src/port.c

@@ -31,6 +31,9 @@ write(pic_state *pic, pic_value obj)
   case PIC_TT_SYMBOL:
     printf("%s", pic_symbol_name(pic, pic_sym(obj)));
     break;
+  case PIC_TT_CHAR:
+    printf("#\\%c", pic_char(obj));
+    break;
   case PIC_TT_FLOAT:
     printf("%f", pic_float(obj));
     break;

src/scan.l

@@ -78,6 +78,11 @@ infnan		"+inf.0"|"-inf.0"|"+nan.0"|"-nan.0"
 			}
 }
 
+#\\.		{
+  yylvalp->c = yytext[2];
+  return tCHAR;
+}
+
 %%
 
 int

src/value.c

@@ -21,6 +21,8 @@ pic_type(pic_value v)
     return PIC_TT_INT;
   case PIC_VTYPE_SYMBOL:
     return PIC_TT_SYMBOL;
+  case PIC_VTYPE_CHAR:
+    return PIC_TT_CHAR;
   case PIC_VTYPE_EOF:
     return PIC_TT_EOF;
   case PIC_VTYPE_HEAP:
@@ -132,6 +134,16 @@ pic_symbol_value(pic_sym sym)
   return v;
 }
 
+pic_value
+pic_char_value(char c)
+{
+  pic_value v;
+
+  v.type = PIC_VTYPE_CHAR;
+  v.u.c = c;
+  return v;
+}
+
 pic_value
 pic_undef_value()
 {

src/vm.c

@@ -237,10 +237,11 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
 #if PIC_DIRECT_THREADED_VM
   static void *oplabels[] = {
     &&L_OP_POP, &&L_OP_PUSHNIL, &&L_OP_PUSHTRUE, &&L_OP_PUSHFALSE, &&L_OP_PUSHFLOAT,
-    &&L_OP_PUSHINT, &&L_OP_PUSHCONST, &&L_OP_GREF, &&L_OP_GSET, &&L_OP_LREF,
+    &&L_OP_PUSHINT, &&L_OP_PUSHCHAR, &&L_OP_PUSHCONST,
-    &&L_OP_LSET, &&L_OP_CREF, &&L_OP_CSET, &&L_OP_JMP, &&L_OP_JMPIF, &&L_OP_CALL,
+    &&L_OP_GREF, &&L_OP_GSET, &&L_OP_LREF, &&L_OP_LSET, &&L_OP_CREF, &&L_OP_CSET,
-    &&L_OP_TAILCALL, &&L_OP_RET, &&L_OP_LAMBDA, &&L_OP_CONS, &&L_OP_CAR, &&L_OP_CDR,
+    &&L_OP_JMP, &&L_OP_JMPIF, &&L_OP_CALL, &&L_OP_TAILCALL, &&L_OP_RET, &&L_OP_LAMBDA,
-    &&L_OP_NILP, &&L_OP_ADD, &&L_OP_SUB, &&L_OP_MUL, &&L_OP_DIV,
+    &&L_OP_CONS, &&L_OP_CAR, &&L_OP_CDR, &&L_OP_NILP,
+    &&L_OP_ADD, &&L_OP_SUB, &&L_OP_MUL, &&L_OP_DIV,
     &&L_OP_EQ, &&L_OP_LT, &&L_OP_LE, &&L_OP_STOP
   };
 #endif
@@ -306,6 +307,10 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
       PUSH(pic_int_value(c.u.i));
       NEXT;
     }
+    CASE(OP_PUSHCHAR) {
+      PUSH(pic_char_value(c.u.c));
+      NEXT;
+    }
     CASE(OP_PUSHCONST) {
       PUSH(pic->pool[c.u.i]);
       NEXT;