mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-11 15:07:34 +02:00
mutable parameters
This commit is contained in:
parent
72886b897f
commit
177003299e
4 changed files with 125 additions and 105 deletions
19
eval.c
19
eval.c
|
@ -665,10 +665,11 @@ static void generate_opcode_app (sexp app, sexp context) {
|
||||||
/* maybe push the default for an optional argument */
|
/* maybe push the default for an optional argument */
|
||||||
if ((num_args == sexp_opcode_num_args(op))
|
if ((num_args == sexp_opcode_num_args(op))
|
||||||
&& sexp_opcode_variadic_p(op)
|
&& sexp_opcode_variadic_p(op)
|
||||||
&& sexp_opcode_data(op)
|
&& sexp_opcode_default(op)
|
||||||
&& sexp_opcode_opt_param_p(op)) {
|
&& (sexp_opcode_class(op) != OPC_PARAMETER)) {
|
||||||
emit_push(sexp_opcode_data(op), context);
|
emit_push(sexp_opcode_default(op), context);
|
||||||
emit(OP_CDR, context);
|
if (sexp_opcode_opt_param_p(op))
|
||||||
|
emit(OP_CDR, context);
|
||||||
sexp_context_depth(context)++;
|
sexp_context_depth(context)++;
|
||||||
num_args++;
|
num_args++;
|
||||||
}
|
}
|
||||||
|
@ -714,8 +715,8 @@ static void generate_opcode_app (sexp app, sexp context) {
|
||||||
emit_word((sexp_uint_t)sexp_opcode_data(op), context);
|
emit_word((sexp_uint_t)sexp_opcode_data(op), context);
|
||||||
break;
|
break;
|
||||||
case OPC_PARAMETER:
|
case OPC_PARAMETER:
|
||||||
emit_push(sexp_opcode_data(op), context);
|
emit_push(sexp_opcode_default(op), context);
|
||||||
emit(OP_CDR, context);
|
emit((num_args == 0 ? OP_CDR : OP_SET_CDR), context);
|
||||||
default:
|
default:
|
||||||
emit(sexp_opcode_code(op), context);
|
emit(sexp_opcode_code(op), context);
|
||||||
}
|
}
|
||||||
|
@ -1654,10 +1655,10 @@ static sexp sexp_make_standard_env (sexp version) {
|
||||||
op = &opcodes[i];
|
op = &opcodes[i];
|
||||||
if ((! standard_env_syms_interned_p)
|
if ((! standard_env_syms_interned_p)
|
||||||
&& sexp_opcode_opt_param_p(op)
|
&& sexp_opcode_opt_param_p(op)
|
||||||
&& sexp_opcode_data(op)) {
|
&& sexp_opcode_default(op)) {
|
||||||
sym = sexp_intern((char*)sexp_opcode_data(op));
|
sym = sexp_intern((char*)sexp_opcode_default(op));
|
||||||
cell = env_cell_create(e, sym, SEXP_UNDEF);
|
cell = env_cell_create(e, sym, SEXP_UNDEF);
|
||||||
sexp_opcode_data(op) = cell;
|
sexp_opcode_default(op) = cell;
|
||||||
}
|
}
|
||||||
env_define(e, sexp_intern(sexp_opcode_name(op)), op);
|
env_define(e, sexp_intern(sexp_opcode_name(op)), op);
|
||||||
}
|
}
|
||||||
|
|
17
init.scm
17
init.scm
|
@ -2,7 +2,6 @@
|
||||||
;; syntax-rules
|
;; syntax-rules
|
||||||
;; number->string string->number
|
;; number->string string->number
|
||||||
;; symbol->string string->symbol
|
;; symbol->string string->symbol
|
||||||
;; with-input-from-file with-output-to-file
|
|
||||||
|
|
||||||
;; provide c[ad]{2,4}r
|
;; provide c[ad]{2,4}r
|
||||||
|
|
||||||
|
@ -446,6 +445,22 @@
|
||||||
(close-output-port in)
|
(close-output-port in)
|
||||||
res))
|
res))
|
||||||
|
|
||||||
|
(define (with-input-from-file file thunk)
|
||||||
|
(let ((old-in (current-input-port))
|
||||||
|
(tmp-in (open-input-file file)))
|
||||||
|
(current-input-port tmp-in)
|
||||||
|
(let ((res (thunk)))
|
||||||
|
(current-input-port old-in)
|
||||||
|
res)))
|
||||||
|
|
||||||
|
(define (with-output-to-file file thunk)
|
||||||
|
(let ((old-out (current-input-port))
|
||||||
|
(tmp-out (open-output-file file)))
|
||||||
|
(current-input-port tmp-out)
|
||||||
|
(let ((res (thunk)))
|
||||||
|
(current-output-port old-out)
|
||||||
|
res)))
|
||||||
|
|
||||||
;; values
|
;; values
|
||||||
|
|
||||||
(define *values-tag* (list 'values))
|
(define *values-tag* (list 'values))
|
||||||
|
|
191
opcodes.c
191
opcodes.c
|
@ -1,60 +1,63 @@
|
||||||
|
|
||||||
#define _OP(c,o,n,m,t,u,i,s,d,p) {.tag=SEXP_OPCODE, .value={.opcode={c, o, n, m, t, u, i, s, d, p}}}
|
#define _OP(c,o,n,m,t,u,i,s,f,d) \
|
||||||
#define _FN(o,n,t,u,s,f) _OP(OPC_FOREIGN, o, n, 0, t, u, 0, s, (sexp)f, NULL)
|
{.tag=SEXP_OPCODE, \
|
||||||
#define _FN0(s, f) _FN(OP_FCALL0, 0, 0, 0, s, f)
|
.value={.opcode={c, o, n, m, t, u, i, s, f, d, NULL}}}
|
||||||
#define _FN1(t, s, f) _FN(OP_FCALL1, 1, t, 0, s, f)
|
#define _FN(o,n,m,t,u,s,f,d) _OP(OPC_FOREIGN, o, n, m, t, u, 0, s, f, (sexp)d)
|
||||||
#define _FN2(t, u, s, f) _FN(OP_FCALL2, 2, t, u, s, f)
|
#define _FN0(s, f, d) _FN(OP_FCALL0, 0, 0, 0, 0, s, f, d)
|
||||||
#define _FN3(t, u, s, f) _FN(OP_FCALL3, 3, t, u, s, f)
|
#define _FN1(t, s, f, d) _FN(OP_FCALL1, 1, 0, t, 0, s, f, d)
|
||||||
#define _FN4(t, u, s, f) _FN(OP_FCALL4, 4, t, u, s, f)
|
#define _FN2(t, u, s, f, d) _FN(OP_FCALL2, 2, 0, t, u, s, f, d)
|
||||||
#define _PARAM(n,a,t) _OP(OPC_PARAMETER, OP_NOOP, 0, 2, t, 0, 0, n, a, NULL)
|
#define _FN2OPT(t, u, s, f, d) _FN(OP_FCALL2, 1, 1, t, u, s, f, d)
|
||||||
|
#define _FN3(t, u, s, f, d) _FN(OP_FCALL3, 3, 0, t, u, s, f, d)
|
||||||
|
#define _FN4(t, u, s, f, d) _FN(OP_FCALL4, 4, 0, t, u, s, f, d)
|
||||||
|
#define _PARAM(n, a, t) _OP(OPC_PARAMETER, OP_NOOP, 0, 3, t, 0, 0, n, a, 0)
|
||||||
|
|
||||||
static struct sexp_struct opcodes[] = {
|
static struct sexp_struct opcodes[] = {
|
||||||
_OP(OPC_ACCESSOR, OP_CAR, 1, 0, SEXP_PAIR, 0, 0, "car", NULL, NULL),
|
_OP(OPC_ACCESSOR, OP_CAR, 1, 0, SEXP_PAIR, 0, 0, "car", 0, NULL),
|
||||||
_OP(OPC_ACCESSOR, OP_SET_CAR, 2, 0, SEXP_PAIR, 0, 0, "set-car!", NULL, NULL),
|
_OP(OPC_ACCESSOR, OP_SET_CAR, 2, 0, SEXP_PAIR, 0, 0, "set-car!", 0, NULL),
|
||||||
_OP(OPC_ACCESSOR, OP_CDR, 1, 0, SEXP_PAIR, 0, 0, "cdr", NULL, NULL),
|
_OP(OPC_ACCESSOR, OP_CDR, 1, 0, SEXP_PAIR, 0, 0, "cdr", 0, NULL),
|
||||||
_OP(OPC_ACCESSOR, OP_SET_CDR, 2, 0, SEXP_PAIR, 0, 0, "set-cdr!", NULL, NULL),
|
_OP(OPC_ACCESSOR, OP_SET_CDR, 2, 0, SEXP_PAIR, 0, 0, "set-cdr!", 0, NULL),
|
||||||
_OP(OPC_ACCESSOR, OP_VECTOR_REF,2,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-ref", NULL, NULL),
|
_OP(OPC_ACCESSOR, OP_VECTOR_REF,2,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-ref", 0, NULL),
|
||||||
_OP(OPC_ACCESSOR, OP_VECTOR_SET,3,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-set!", NULL, NULL),
|
_OP(OPC_ACCESSOR, OP_VECTOR_SET,3,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-set!", 0, NULL),
|
||||||
_OP(OPC_ACCESSOR, OP_VECTOR_LENGTH,1,0, SEXP_VECTOR, 0, 0,"vector-length", NULL, NULL),
|
_OP(OPC_ACCESSOR, OP_VECTOR_LENGTH,1,0, SEXP_VECTOR, 0, 0,"vector-length", 0, NULL),
|
||||||
_OP(OPC_ACCESSOR, OP_STRING_REF,2,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-ref", NULL, NULL),
|
_OP(OPC_ACCESSOR, OP_STRING_REF,2,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-ref", 0, NULL),
|
||||||
_OP(OPC_ACCESSOR, OP_STRING_SET,3,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-set!", NULL, NULL),
|
_OP(OPC_ACCESSOR, OP_STRING_SET,3,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-set!", 0, NULL),
|
||||||
_OP(OPC_ACCESSOR, OP_STRING_LENGTH,1,0, SEXP_STRING, 0, 0,"string-length", NULL, NULL),
|
_OP(OPC_ACCESSOR, OP_STRING_LENGTH,1,0, SEXP_STRING, 0, 0,"string-length", 0, NULL),
|
||||||
_OP(OPC_GENERIC, OP_FIX2FLO, 1, 0, 0, 0, 0, "exact->inexact", NULL, NULL),
|
_OP(OPC_GENERIC, OP_FIX2FLO, 1, 0, 0, 0, 0, "exact->inexact", 0, NULL),
|
||||||
_OP(OPC_GENERIC, OP_FLO2FIX, 1, 0, 0, 0, 0, "inexact->exact", NULL, NULL),
|
_OP(OPC_GENERIC, OP_FLO2FIX, 1, 0, 0, 0, 0, "inexact->exact", 0, NULL),
|
||||||
_OP(OPC_GENERIC, OP_CHAR2INT, 1, 0, SEXP_CHAR, 0, 0, "char->integer", NULL, NULL),
|
_OP(OPC_GENERIC, OP_CHAR2INT, 1, 0, SEXP_CHAR, 0, 0, "char->integer", 0, NULL),
|
||||||
_OP(OPC_GENERIC, OP_INT2CHAR, 1, 0, SEXP_FIXNUM, 0, 0, "integer->char", NULL, NULL),
|
_OP(OPC_GENERIC, OP_INT2CHAR, 1, 0, SEXP_FIXNUM, 0, 0, "integer->char", 0, NULL),
|
||||||
_OP(OPC_GENERIC, OP_CHAR_UPCASE, 1, 0, SEXP_CHAR, 0, 0, "char-upcase", NULL, NULL),
|
_OP(OPC_GENERIC, OP_CHAR_UPCASE, 1, 0, SEXP_CHAR, 0, 0, "char-upcase", 0, NULL),
|
||||||
_OP(OPC_GENERIC, OP_CHAR_DOWNCASE, 1, 0, SEXP_CHAR, 0, 0, "char-downcase", NULL, NULL),
|
_OP(OPC_GENERIC, OP_CHAR_DOWNCASE, 1, 0, SEXP_CHAR, 0, 0, "char-downcase", 0, NULL),
|
||||||
_OP(OPC_ARITHMETIC, OP_ADD, 0, 1, SEXP_FIXNUM, 0, 0, "+", NULL, NULL),
|
_OP(OPC_ARITHMETIC, OP_ADD, 0, 1, SEXP_FIXNUM, 0, 0, "+", sexp_make_integer(0), NULL),
|
||||||
_OP(OPC_ARITHMETIC, OP_MUL, 0, 1, SEXP_FIXNUM, 0, 0, "*", NULL, NULL),
|
_OP(OPC_ARITHMETIC, OP_MUL, 0, 1, SEXP_FIXNUM, 0, 0, "*", sexp_make_integer(1), NULL),
|
||||||
_OP(OPC_ARITHMETIC_INV, OP_SUB, 0, 1, SEXP_FIXNUM, 0, OP_NEGATIVE, "-", NULL, NULL),
|
_OP(OPC_ARITHMETIC_INV, OP_SUB, 0, 1, SEXP_FIXNUM, 0, OP_NEGATIVE, "-", 0, NULL),
|
||||||
_OP(OPC_ARITHMETIC_INV, OP_DIV, 0, 1, SEXP_FIXNUM, 0, OP_INVERSE, "/", NULL, NULL),
|
_OP(OPC_ARITHMETIC_INV, OP_DIV, 0, 1, SEXP_FIXNUM, 0, OP_INVERSE, "/", 0, NULL),
|
||||||
_OP(OPC_ARITHMETIC, OP_QUOTIENT, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "quotient", NULL, NULL),
|
_OP(OPC_ARITHMETIC, OP_QUOTIENT, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "quotient", 0, NULL),
|
||||||
_OP(OPC_ARITHMETIC, OP_REMAINDER, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "remainder", NULL, NULL),
|
_OP(OPC_ARITHMETIC, OP_REMAINDER, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "remainder", 0, NULL),
|
||||||
_OP(OPC_ARITHMETIC_CMP, OP_LT, 0, 1, SEXP_FIXNUM, 0, 0, "<", NULL, NULL),
|
_OP(OPC_ARITHMETIC_CMP, OP_LT, 0, 1, SEXP_FIXNUM, 0, 0, "<", 0, NULL),
|
||||||
_OP(OPC_ARITHMETIC_CMP, OP_LE, 0, 1, SEXP_FIXNUM, 0, 0, "<=", NULL, NULL),
|
_OP(OPC_ARITHMETIC_CMP, OP_LE, 0, 1, SEXP_FIXNUM, 0, 0, "<=", 0, NULL),
|
||||||
_OP(OPC_ARITHMETIC_CMP, OP_LT, 0, 1, SEXP_FIXNUM, 0, 1, ">", NULL, NULL),
|
_OP(OPC_ARITHMETIC_CMP, OP_LT, 0, 1, SEXP_FIXNUM, 0, 1, ">", 0, NULL),
|
||||||
_OP(OPC_ARITHMETIC_CMP, OP_LE, 0, 1, SEXP_FIXNUM, 0, 1, ">=", NULL, NULL),
|
_OP(OPC_ARITHMETIC_CMP, OP_LE, 0, 1, SEXP_FIXNUM, 0, 1, ">=", 0, NULL),
|
||||||
_OP(OPC_ARITHMETIC_CMP, OP_EQN, 0, 1, SEXP_FIXNUM, 0, 0, "=", NULL, NULL),
|
_OP(OPC_ARITHMETIC_CMP, OP_EQN, 0, 1, SEXP_FIXNUM, 0, 0, "=", 0, NULL),
|
||||||
_OP(OPC_PREDICATE, OP_EQ, 2, 0, 0, 0, 0, "eq?", NULL, NULL),
|
_OP(OPC_PREDICATE, OP_EQ, 2, 0, 0, 0, 0, "eq?", 0, NULL),
|
||||||
_OP(OPC_CONSTRUCTOR, OP_CONS, 2, 0, 0, 0, 0, "cons", NULL, NULL),
|
_OP(OPC_CONSTRUCTOR, OP_CONS, 2, 0, 0, 0, 0, "cons", 0, NULL),
|
||||||
_OP(OPC_CONSTRUCTOR, OP_MAKE_VECTOR, 2, 0, SEXP_FIXNUM, 0, 0, "make-vector", NULL, NULL),
|
_OP(OPC_CONSTRUCTOR, OP_MAKE_VECTOR, 1, 1, SEXP_FIXNUM, 0, 0, "make-vector", SEXP_UNDEF, NULL),
|
||||||
_OP(OPC_CONSTRUCTOR, OP_MAKE_PROCEDURE, 4, 0, 0, 0, 0, "make-procedure", NULL, NULL),
|
_OP(OPC_CONSTRUCTOR, OP_MAKE_PROCEDURE, 4, 0, 0, 0, 0, "make-procedure", 0, NULL),
|
||||||
_OP(OPC_TYPE_PREDICATE, OP_NULLP, 1, 0, 0, 0, 0, "null?", NULL, NULL),
|
_OP(OPC_TYPE_PREDICATE, OP_NULLP, 1, 0, 0, 0, 0, "null?", 0, NULL),
|
||||||
_OP(OPC_TYPE_PREDICATE, OP_EOFP, 1, 0, 0, 0, 0, "eof-object?", NULL, NULL),
|
_OP(OPC_TYPE_PREDICATE, OP_EOFP, 1, 0, 0, 0, 0, "eof-object?", 0, NULL),
|
||||||
_OP(OPC_TYPE_PREDICATE, OP_SYMBOLP, 1, 0, 0, 0, 0, "symbol?", NULL, NULL),
|
_OP(OPC_TYPE_PREDICATE, OP_SYMBOLP, 1, 0, 0, 0, 0, "symbol?", 0, NULL),
|
||||||
_OP(OPC_TYPE_PREDICATE, OP_CHARP, 1, 0, 0, 0, 0, "char?", NULL, NULL),
|
_OP(OPC_TYPE_PREDICATE, OP_CHARP, 1, 0, 0, 0, 0, "char?", 0, NULL),
|
||||||
_OP(OPC_TYPE_PREDICATE, OP_INTEGERP, 1, 0, 0, 0, 0, "fixnum?", NULL, NULL),
|
_OP(OPC_TYPE_PREDICATE, OP_INTEGERP, 1, 0, 0, 0, 0, "fixnum?", 0, NULL),
|
||||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "pair?", (sexp)SEXP_PAIR, NULL),
|
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "pair?", 0, (sexp)SEXP_PAIR),
|
||||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "string?", (sexp)SEXP_STRING, NULL),
|
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "string?", 0, (sexp)SEXP_STRING),
|
||||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "vector?", (sexp)SEXP_VECTOR, NULL),
|
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "vector?", 0, (sexp)SEXP_VECTOR),
|
||||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "flonum?", (sexp)SEXP_FLONUM, NULL),
|
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "flonum?", 0, (sexp)SEXP_FLONUM),
|
||||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "procedure?", (sexp)SEXP_PROCEDURE, NULL),
|
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "procedure?", 0, (sexp)SEXP_PROCEDURE),
|
||||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "input-port?", (sexp)SEXP_IPORT, NULL),
|
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "input-port?", 0, (sexp)SEXP_IPORT),
|
||||||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "output-port?", (sexp)SEXP_OPORT, NULL),
|
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "output-port?", 0, (sexp)SEXP_OPORT),
|
||||||
_OP(OPC_GENERIC, OP_APPLY1, 2, 0, SEXP_PROCEDURE, SEXP_PAIR, 0, "apply1", NULL, NULL),
|
_OP(OPC_GENERIC, OP_APPLY1, 2, 0, SEXP_PROCEDURE, SEXP_PAIR, 0, "apply1", 0, NULL),
|
||||||
_OP(OPC_GENERIC, OP_CALLCC, 1, SEXP_PROCEDURE, 0, 0, 0, "call-with-current-continuation", NULL, NULL),
|
_OP(OPC_GENERIC, OP_CALLCC, 1, SEXP_PROCEDURE, 0, 0, 0, "call-with-current-continuation", 0, NULL),
|
||||||
_OP(OPC_GENERIC, OP_ERROR, 1, SEXP_STRING, 0, 0, 0, "error", NULL, NULL),
|
_OP(OPC_GENERIC, OP_ERROR, 1, SEXP_STRING, 0, 0, 0, "error", 0, NULL),
|
||||||
_OP(OPC_IO, OP_WRITE, 1, 3, 0, SEXP_OPORT, 0, "write", (sexp)"*current-output-port*", NULL),
|
_OP(OPC_IO, OP_WRITE, 1, 3, 0, SEXP_OPORT, 0, "write", (sexp)"*current-output-port*", NULL),
|
||||||
_OP(OPC_IO, OP_DISPLAY, 1, 3, 0, SEXP_OPORT, 0, "display", (sexp)"*current-output-port*", NULL),
|
_OP(OPC_IO, OP_DISPLAY, 1, 3, 0, SEXP_OPORT, 0, "display", (sexp)"*current-output-port*", NULL),
|
||||||
_OP(OPC_IO, OP_WRITE_CHAR, 1, 3, 0, SEXP_OPORT, 0, "write-char", (sexp)"*current-output-port*", NULL),
|
_OP(OPC_IO, OP_WRITE_CHAR, 1, 3, 0, SEXP_OPORT, 0, "write-char", (sexp)"*current-output-port*", NULL),
|
||||||
|
@ -64,56 +67,56 @@ _OP(OPC_IO, OP_READ, 0, 3, 0, SEXP_IPORT, 0, "read", (sexp)"*current-input-port*
|
||||||
_OP(OPC_IO, OP_READ_CHAR, 0, 3, 0, SEXP_IPORT, 0, "read-char", (sexp)"*current-input-port*", NULL),
|
_OP(OPC_IO, OP_READ_CHAR, 0, 3, 0, SEXP_IPORT, 0, "read-char", (sexp)"*current-input-port*", NULL),
|
||||||
_OP(OPC_IO, OP_PEEK_CHAR, 0, 3, 0, SEXP_IPORT, 0, "peek-char", (sexp)"*current-input-port*", NULL),
|
_OP(OPC_IO, OP_PEEK_CHAR, 0, 3, 0, SEXP_IPORT, 0, "peek-char", (sexp)"*current-input-port*", NULL),
|
||||||
_OP(OPC_GENERIC, OP_EVAL, 1, 3, 0, 0, 0, "eval", (sexp)"*interaction-environment*", NULL),
|
_OP(OPC_GENERIC, OP_EVAL, 1, 3, 0, 0, 0, "eval", (sexp)"*interaction-environment*", NULL),
|
||||||
_FN2(0, 0, "equal?", sexp_equalp),
|
_FN2(0, 0, "equal?", 0, sexp_equalp),
|
||||||
_FN1(0, "list?", sexp_listp),
|
_FN1(0, "list?", 0, sexp_listp),
|
||||||
_FN1(0, "identifier?", sexp_identifierp),
|
_FN1(0, "identifier?", 0, sexp_identifierp),
|
||||||
_FN4(0, SEXP_ENV, "identifier=?", sexp_identifier_eq),
|
_FN4(0, SEXP_ENV, "identifier=?", 0, sexp_identifier_eq),
|
||||||
_FN1(SEXP_PAIR, "length", sexp_length),
|
_FN1(SEXP_PAIR, "length", 0, sexp_length),
|
||||||
_FN1(SEXP_PAIR, "reverse", sexp_reverse),
|
_FN1(SEXP_PAIR, "reverse", 0, sexp_reverse),
|
||||||
_FN1(SEXP_PAIR, "list->vector", sexp_list_to_vector),
|
_FN1(SEXP_PAIR, "list->vector", 0, sexp_list_to_vector),
|
||||||
_FN1(SEXP_STRING, "open-input-file", sexp_open_input_file),
|
_FN1(SEXP_STRING, "open-input-file", 0, sexp_open_input_file),
|
||||||
_FN1(SEXP_STRING, "open-output-file", sexp_open_output_file),
|
_FN1(SEXP_STRING, "open-output-file", 0, sexp_open_output_file),
|
||||||
_FN1(SEXP_IPORT, "close-input-port", sexp_close_port),
|
_FN1(SEXP_IPORT, "close-input-port", 0, sexp_close_port),
|
||||||
_FN1(SEXP_OPORT, "close-output-port", sexp_close_port),
|
_FN1(SEXP_OPORT, "close-output-port", 0, sexp_close_port),
|
||||||
_FN1(SEXP_FIXNUM, "null-environment", sexp_make_null_env),
|
_FN1(SEXP_FIXNUM, "null-environment", 0, sexp_make_null_env),
|
||||||
_FN1(SEXP_FIXNUM, "scheme-report-environment", sexp_make_standard_env),
|
_FN1(SEXP_FIXNUM, "scheme-report-environment", 0, sexp_make_standard_env),
|
||||||
_FN2(0, SEXP_ENV, "%load", sexp_load),
|
_FN2(SEXP_STRING, SEXP_ENV, "%load", 0, sexp_load),
|
||||||
_FN2(SEXP_FIXNUM, SEXP_CHAR, "make-string", sexp_make_string),
|
_FN2OPT(SEXP_FIXNUM, SEXP_CHAR, "make-string", sexp_make_character(' '), sexp_make_string),
|
||||||
_FN2(SEXP_STRING, SEXP_STRING, "string-cmp", sexp_string_cmp),
|
_FN2(SEXP_STRING, SEXP_STRING, "string-cmp", 0, sexp_string_cmp),
|
||||||
_FN2(SEXP_STRING, SEXP_STRING, "string-cmp-ci", sexp_string_cmp_ci),
|
_FN2(SEXP_STRING, SEXP_STRING, "string-cmp-ci", 0, sexp_string_cmp_ci),
|
||||||
_FN3(SEXP_STRING, SEXP_FIXNUM, "substring", sexp_substring),
|
_FN3(SEXP_STRING, SEXP_FIXNUM, "substring", 0, sexp_substring),
|
||||||
_FN1(SEXP_PAIR, "string-concatenate", sexp_string_concatenate),
|
_FN1(SEXP_PAIR, "string-concatenate", 0, sexp_string_concatenate),
|
||||||
_FN2(0, SEXP_PAIR, "memq", sexp_memq),
|
_FN2(0, SEXP_PAIR, "memq", 0, sexp_memq),
|
||||||
_FN2(0, SEXP_PAIR, "assq", sexp_assq),
|
_FN2(0, SEXP_PAIR, "assq", 0, sexp_assq),
|
||||||
_FN3(SEXP_ENV, SEXP_PAIR, "make-syntactic-closure", sexp_make_synclo),
|
_FN3(SEXP_ENV, SEXP_PAIR, "make-syntactic-closure", 0, sexp_make_synclo),
|
||||||
_PARAM("current-input-port", (sexp)"*current-input-port*", SEXP_IPORT),
|
_PARAM("current-input-port", (sexp)"*current-input-port*", SEXP_IPORT),
|
||||||
_PARAM("current-output-port", (sexp)"*current-output-port*", SEXP_OPORT),
|
_PARAM("current-output-port", (sexp)"*current-output-port*", SEXP_OPORT),
|
||||||
_PARAM("current-error-port", (sexp)"*current-error-port*", SEXP_OPORT),
|
_PARAM("current-error-port", (sexp)"*current-error-port*", SEXP_OPORT),
|
||||||
_PARAM("current-error-handler", (sexp)"*current-error-handler*", SEXP_PROCEDURE),
|
_PARAM("current-error-handler", (sexp)"*current-error-handler*", SEXP_PROCEDURE),
|
||||||
_PARAM("interaction-environment", (sexp)"*interaction-environment*", SEXP_ENV),
|
_PARAM("interaction-environment", (sexp)"*interaction-environment*", SEXP_ENV),
|
||||||
#if USE_MATH
|
#if USE_MATH
|
||||||
_FN1(0, "exp", sexp_exp),
|
_FN1(0, "exp", 0, sexp_exp),
|
||||||
_FN1(0, "log", sexp_log),
|
_FN1(0, "log", 0, sexp_log),
|
||||||
_FN1(0, "sin", sexp_sin),
|
_FN1(0, "sin", 0, sexp_sin),
|
||||||
_FN1(0, "cos", sexp_cos),
|
_FN1(0, "cos", 0, sexp_cos),
|
||||||
_FN1(0, "tan", sexp_tan),
|
_FN1(0, "tan", 0, sexp_tan),
|
||||||
_FN1(0, "asin", sexp_asin),
|
_FN1(0, "asin", 0, sexp_asin),
|
||||||
_FN1(0, "acos", sexp_acos),
|
_FN1(0, "acos", 0, sexp_acos),
|
||||||
_FN1(0, "atan", sexp_atan),
|
_FN1(0, "atan", 0, sexp_atan),
|
||||||
_FN1(0, "sqrt", sexp_sqrt),
|
_FN1(0, "sqrt", 0, sexp_sqrt),
|
||||||
_FN1(0, "round", sexp_round),
|
_FN1(0, "round", 0, sexp_round),
|
||||||
_FN1(0, "truncate", sexp_trunc),
|
_FN1(0, "truncate", 0, sexp_trunc),
|
||||||
_FN1(0, "floor", sexp_floor),
|
_FN1(0, "floor", 0, sexp_floor),
|
||||||
_FN1(0, "ceiling", sexp_ceiling),
|
_FN1(0, "ceiling", 0, sexp_ceiling),
|
||||||
_FN2(0, 0, "expt", sexp_expt),
|
_FN2(0, 0, "expt", 0, sexp_expt),
|
||||||
#endif
|
#endif
|
||||||
#if USE_STRING_STREAMS
|
#if USE_STRING_STREAMS
|
||||||
_FN0("open-output-string", sexp_make_output_string_port),
|
_FN0("open-output-string", 0, sexp_make_output_string_port),
|
||||||
_FN1(SEXP_STRING, "open-input-string", sexp_make_input_string_port),
|
_FN1(SEXP_STRING, "open-input-string", 0, sexp_make_input_string_port),
|
||||||
_FN1(SEXP_OPORT, "get-output-string", sexp_get_output_string),
|
_FN1(SEXP_OPORT, "get-output-string", 0, sexp_get_output_string),
|
||||||
#endif
|
#endif
|
||||||
#if USE_DEBUG
|
#if USE_DEBUG
|
||||||
_FN2(SEXP_PROCEDURE, SEXP_OPORT, "disasm", sexp_disasm),
|
_FN2(SEXP_PROCEDURE, SEXP_OPORT, "disasm", 0, sexp_disasm),
|
||||||
#endif
|
#endif
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
3
sexp.h
3
sexp.h
|
@ -132,7 +132,7 @@ struct sexp_struct {
|
||||||
unsigned char op_class, code, num_args, flags,
|
unsigned char op_class, code, num_args, flags,
|
||||||
arg1_type, arg2_type, inverse;
|
arg1_type, arg2_type, inverse;
|
||||||
char *name;
|
char *name;
|
||||||
sexp data, proc;
|
sexp dflt, data, proc;
|
||||||
} opcode;
|
} opcode;
|
||||||
struct {
|
struct {
|
||||||
char code;
|
char code;
|
||||||
|
@ -301,6 +301,7 @@ struct sexp_struct {
|
||||||
#define sexp_opcode_arg2_type(x) ((x)->value.opcode.arg2_type)
|
#define sexp_opcode_arg2_type(x) ((x)->value.opcode.arg2_type)
|
||||||
#define sexp_opcode_inverse(x) ((x)->value.opcode.inverse)
|
#define sexp_opcode_inverse(x) ((x)->value.opcode.inverse)
|
||||||
#define sexp_opcode_name(x) ((x)->value.opcode.name)
|
#define sexp_opcode_name(x) ((x)->value.opcode.name)
|
||||||
|
#define sexp_opcode_default(x) ((x)->value.opcode.dflt)
|
||||||
#define sexp_opcode_data(x) ((x)->value.opcode.data)
|
#define sexp_opcode_data(x) ((x)->value.opcode.data)
|
||||||
#define sexp_opcode_proc(x) ((x)->value.opcode.proc)
|
#define sexp_opcode_proc(x) ((x)->value.opcode.proc)
|
||||||
|
|
||||||
|
|
Loading…
Add table
Reference in a new issue