diff --git a/include/picrin/value.h b/include/picrin/value.h index 2dcf3673..cfc958cf 100644 --- a/include/picrin/value.h +++ b/include/picrin/value.h @@ -7,6 +7,7 @@ enum pic_vtype { PIC_VTYPE_FALSE, PIC_VTYPE_UNDEF, PIC_VTYPE_FLOAT, + PIC_VTYPE_EOF, PIC_VTYPE_HEAP }; @@ -23,6 +24,7 @@ enum pic_tt { PIC_TT_NIL, PIC_TT_BOOL, PIC_TT_FLOAT, + PIC_TT_EOF, PIC_TT_UNDEF, /* heap */ PIC_TT_PAIR, diff --git a/src/codegen.c b/src/codegen.c index 1d26dab6..4079fb41 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -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_UNDEF: + case PIC_TT_EOF: case PIC_TT_PORT: { pic_error(pic, "invalid expression given"); } diff --git a/src/gc.c b/src/gc.c index b06f6eb6..c834c096 100644 --- a/src/gc.c +++ b/src/gc.c @@ -159,6 +159,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj) case PIC_TT_NIL: case PIC_TT_BOOL: case PIC_TT_FLOAT: + case PIC_TT_EOF: case PIC_TT_UNDEF: 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_BOOL: case PIC_TT_FLOAT: + case PIC_TT_EOF: case PIC_TT_UNDEF: pic_abort(pic, "logic flaw"); } diff --git a/src/port.c b/src/port.c index e41edbf0..be7884c9 100644 --- a/src/port.c +++ b/src/port.c @@ -32,6 +32,9 @@ write(pic_state *pic, pic_value obj) case PIC_TT_FLOAT: printf("%.10g", pic_float(obj)); break; + case PIC_TT_EOF: + printf("#"); + break; case PIC_TT_UNDEF: printf("#"); break; @@ -103,9 +106,39 @@ pic_port_newline(pic_state *pic) 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 pic_init_port(pic_state *pic) { pic_defun(pic, "write", pic_port_write); 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); } diff --git a/src/value.c b/src/value.c index 7fa303d2..fff723d4 100644 --- a/src/value.c +++ b/src/value.c @@ -17,6 +17,8 @@ pic_type(pic_value v) return PIC_TT_UNDEF; case PIC_VTYPE_FLOAT: return PIC_TT_FLOAT; + case PIC_VTYPE_EOF: + return PIC_TT_EOF; case PIC_VTYPE_HEAP: return ((struct pic_object *)v.u.data)->tt; }