Adding set-port-line! and using it in the pure Scheme load to preserve source info.

This commit is contained in:
Alex Shinn 2013-06-02 10:44:10 +09:00
parent 5797ac661a
commit 1736a8306b
4 changed files with 11 additions and 0 deletions

8
eval.c
View file

@ -1167,6 +1167,14 @@ sexp sexp_close_port_op (sexp ctx, sexp self, sexp_sint_t n, sexp port) {
return sexp_finalize_port(ctx, self, n, port);
}
sexp sexp_set_port_line_op (sexp ctx, sexp self, sexp_sint_t n, sexp port, sexp line) {
sexp_assert_type(ctx, sexp_iportp, SEXP_IPORT, port);
sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, line);
sexp_port_sourcep(port) = 1;
sexp_port_line(port) = sexp_unbox_fixnum(line);
return SEXP_VOID;
}
#if SEXP_USE_STATIC_LIBS
#ifndef PLAN9
#include "clibs.c"

View file

@ -115,6 +115,7 @@ SEXP_API sexp sexp_open_output_file_op(sexp ctx, sexp self, sexp_sint_t n, sexp
SEXP_API sexp sexp_open_binary_input_file(sexp ctx, sexp self, sexp_sint_t n, sexp x);
SEXP_API sexp sexp_open_binary_output_file(sexp ctx, sexp self, sexp_sint_t n, sexp x);
SEXP_API sexp sexp_close_port_op(sexp ctx, sexp self, sexp_sint_t n, sexp x);
SEXP_API sexp sexp_set_port_line_op (sexp ctx, sexp self, sexp_sint_t n, sexp port, sexp line);
SEXP_API sexp sexp_env_define (sexp ctx, sexp env, sexp sym, sexp val);
SEXP_API sexp sexp_env_cell (sexp env, sexp sym, int localp);
SEXP_API sexp sexp_env_ref (sexp env, sexp sym, sexp dflt);

View file

@ -1001,6 +1001,7 @@
(else
(call-with-input-file file
(lambda (in)
(set-port-line! in 1)
(let lp ()
(let ((x (read in)))
(cond

View file

@ -190,6 +190,7 @@ _FN1(_I(SEXP_IPORT), _I(SEXP_STRING), "open-input-string", 0, sexp_make_input_st
_FN1(_I(SEXP_STRING), _I(SEXP_OPORT), "get-output-string", 0, sexp_get_output_string_op),
_FN2OPT(_I(SEXP_IPORT), _I(SEXP_FIXNUM), _I(SEXP_BOOLEAN), "open-input-file-descriptor", SEXP_FALSE, sexp_open_input_file_descriptor),
_FN2OPT(_I(SEXP_OPORT), _I(SEXP_FIXNUM), _I(SEXP_BOOLEAN), "open-output-file-descriptor", SEXP_FALSE, sexp_open_output_file_descriptor),
_FN2(_I(SEXP_VOID), _I(SEXP_IPORT), _I(SEXP_FIXNUM), "set-port-line!", 0, sexp_set_port_line_op),
_FN2OPT(_I(SEXP_OBJECT), _I(SEXP_PROCEDURE), _I(SEXP_FIXNUM), "register-optimization!", _I(600), sexp_register_optimization),
#if SEXP_USE_MATH
_FN1(_I(SEXP_NUMBER), _I(SEXP_NUMBER), "exp", 0, sexp_exp),