add eof-object type

This commit is contained in:
Yuichi Nishiwaki 2013-10-22 16:02:20 +09:00
parent 176d167de8
commit b45d7d9592
5 changed files with 40 additions and 0 deletions

View File

@ -7,6 +7,7 @@ enum pic_vtype {
PIC_VTYPE_FALSE, PIC_VTYPE_FALSE,
PIC_VTYPE_UNDEF, PIC_VTYPE_UNDEF,
PIC_VTYPE_FLOAT, PIC_VTYPE_FLOAT,
PIC_VTYPE_EOF,
PIC_VTYPE_HEAP PIC_VTYPE_HEAP
}; };
@ -23,6 +24,7 @@ enum pic_tt {
PIC_TT_NIL, PIC_TT_NIL,
PIC_TT_BOOL, PIC_TT_BOOL,
PIC_TT_FLOAT, PIC_TT_FLOAT,
PIC_TT_EOF,
PIC_TT_UNDEF, PIC_TT_UNDEF,
/* heap */ /* heap */
PIC_TT_PAIR, PIC_TT_PAIR,

View File

@ -383,6 +383,7 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en
} }
case PIC_TT_PROC: case PIC_TT_PROC:
case PIC_TT_UNDEF: case PIC_TT_UNDEF:
case PIC_TT_EOF:
case PIC_TT_PORT: { case PIC_TT_PORT: {
pic_error(pic, "invalid expression given"); pic_error(pic, "invalid expression given");
} }

View File

@ -159,6 +159,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
case PIC_TT_NIL: case PIC_TT_NIL:
case PIC_TT_BOOL: case PIC_TT_BOOL:
case PIC_TT_FLOAT: case PIC_TT_FLOAT:
case PIC_TT_EOF:
case PIC_TT_UNDEF: case PIC_TT_UNDEF:
pic_abort(pic, "logic flaw"); pic_abort(pic, "logic flaw");
} }
@ -276,6 +277,7 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
case PIC_TT_NIL: case PIC_TT_NIL:
case PIC_TT_BOOL: case PIC_TT_BOOL:
case PIC_TT_FLOAT: case PIC_TT_FLOAT:
case PIC_TT_EOF:
case PIC_TT_UNDEF: case PIC_TT_UNDEF:
pic_abort(pic, "logic flaw"); pic_abort(pic, "logic flaw");
} }

View File

@ -32,6 +32,9 @@ write(pic_state *pic, pic_value obj)
case PIC_TT_FLOAT: case PIC_TT_FLOAT:
printf("%.10g", pic_float(obj)); printf("%.10g", pic_float(obj));
break; break;
case PIC_TT_EOF:
printf("#<eof-object>");
break;
case PIC_TT_UNDEF: case PIC_TT_UNDEF:
printf("#<undef>"); printf("#<undef>");
break; break;
@ -103,9 +106,39 @@ pic_port_newline(pic_state *pic)
return pic_false_value(); return pic_false_value();
} }
static pic_value
pic_port_eof_object_p(pic_state *pic)
{
pic_value v;
pic_get_args(pic, "o", &v);
if (v.type == PIC_VTYPE_EOF) {
return pic_true_value();
}
else {
return pic_false_value();
}
}
static pic_value
pic_port_eof_object(pic_state *pic)
{
pic_value v;
pic_get_args(pic, "");
v.type = PIC_VTYPE_EOF;
v.u.data = NULL;
return v;
}
void void
pic_init_port(pic_state *pic) pic_init_port(pic_state *pic)
{ {
pic_defun(pic, "write", pic_port_write); pic_defun(pic, "write", pic_port_write);
pic_defun(pic, "newline", pic_port_newline); pic_defun(pic, "newline", pic_port_newline);
pic_defun(pic, "eof-object?", pic_port_eof_object_p);
pic_defun(pic, "eof-object", pic_port_eof_object);
} }

View File

@ -17,6 +17,8 @@ pic_type(pic_value v)
return PIC_TT_UNDEF; return PIC_TT_UNDEF;
case PIC_VTYPE_FLOAT: case PIC_VTYPE_FLOAT:
return PIC_TT_FLOAT; return PIC_TT_FLOAT;
case PIC_VTYPE_EOF:
return PIC_TT_EOF;
case PIC_VTYPE_HEAP: case PIC_VTYPE_HEAP:
return ((struct pic_object *)v.u.data)->tt; return ((struct pic_object *)v.u.data)->tt;
} }