adding port-source?[-set!] to ast

This commit is contained in:
Alex Shinn 2019-08-15 23:18:07 +08:00
parent 93b718f7c3
commit 39f34ffffb
3 changed files with 16 additions and 1 deletions

View file

@ -216,6 +216,18 @@ sexp sexp_set_port_line (sexp ctx, sexp self, sexp_sint_t n, sexp p, sexp i) {
return SEXP_VOID; return SEXP_VOID;
} }
sexp sexp_get_port_sourcep (sexp ctx, sexp self, sexp_sint_t n, sexp p) {
sexp_assert_type(ctx, sexp_portp, SEXP_IPORT, p);
return sexp_make_boolean(sexp_port_sourcep(p));
}
sexp sexp_set_port_sourcep (sexp ctx, sexp self, sexp_sint_t n, sexp p, sexp b) {
sexp_assert_type(ctx, sexp_portp, SEXP_IPORT, p);
sexp_assert_type(ctx, sexp_booleanp, SEXP_BOOLEAN, b);
sexp_port_sourcep(p) = sexp_truep(b);
return SEXP_VOID;
}
sexp sexp_type_of (sexp ctx, sexp self, sexp_sint_t n, sexp x) { sexp sexp_type_of (sexp ctx, sexp self, sexp_sint_t n, sexp x) {
if (!x) if (!x)
return sexp_type_by_index(ctx, SEXP_OBJECT); return sexp_type_by_index(ctx, SEXP_OBJECT);
@ -698,6 +710,8 @@ sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char
sexp_define_foreign(ctx, env, "opcode-param-type", 2, sexp_get_opcode_param_type); sexp_define_foreign(ctx, env, "opcode-param-type", 2, sexp_get_opcode_param_type);
sexp_define_foreign(ctx, env, "port-line", 1, sexp_get_port_line); sexp_define_foreign(ctx, env, "port-line", 1, sexp_get_port_line);
sexp_define_foreign(ctx, env, "port-line-set!", 2, sexp_set_port_line); sexp_define_foreign(ctx, env, "port-line-set!", 2, sexp_set_port_line);
sexp_define_foreign(ctx, env, "port-source?", 1, sexp_get_port_sourcep);
sexp_define_foreign(ctx, env, "port-source?-set!", 2, sexp_set_port_sourcep);
sexp_define_foreign(ctx, env, "type-of", 1, sexp_type_of); sexp_define_foreign(ctx, env, "type-of", 1, sexp_type_of);
sexp_define_foreign(ctx, env, "type-name", 1, sexp_type_name_op); sexp_define_foreign(ctx, env, "type-name", 1, sexp_type_name_op);
sexp_define_foreign(ctx, env, "type-cpl", 1, sexp_type_cpl_op); sexp_define_foreign(ctx, env, "type-cpl", 1, sexp_type_cpl_op);

View file

@ -30,7 +30,7 @@
procedure-code procedure-vars procedure-name procedure-name-set! procedure-code procedure-vars procedure-name procedure-name-set!
procedure-arity procedure-variadic? procedure-flags procedure-arity procedure-variadic? procedure-flags
bytecode-name bytecode-literals bytecode-source bytecode-name bytecode-literals bytecode-source
port-line port-line-set! port-line port-line-set! port-source? port-source?-set!
extend-env env-parent env-parent-set! env-lambda env-lambda-set! extend-env env-parent env-parent-set! env-lambda env-lambda-set!
env-define! env-push! env-syntactic? env-syntactic?-set! core-code env-define! env-push! env-syntactic? env-syntactic?-set! core-code
type-name type-cpl type-parent type-slots type-num-slots type-name type-cpl type-parent type-slots type-num-slots

View file

@ -7,6 +7,7 @@
(define (file->sexp-list file) (define (file->sexp-list file)
(call-with-input-file file (call-with-input-file file
(lambda (in) (lambda (in)
(port-source?-set! in #t)
(let lp ((res '())) (let lp ((res '()))
(let ((x (read in))) (let ((x (read in)))
(if (eof-object? x) (if (eof-object? x)