mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-11 06:57:33 +02:00
making literals immutable
This commit is contained in:
parent
f1e7c3a2db
commit
78ceffdee4
3 changed files with 23 additions and 3 deletions
12
eval.c
12
eval.c
|
@ -331,6 +331,7 @@ static sexp sexp_strip_synclos (sexp ctx, sexp x) {
|
|||
kar = sexp_strip_synclos(ctx, sexp_car(x));
|
||||
kdr = sexp_strip_synclos(ctx, sexp_cdr(x));
|
||||
res = sexp_cons(ctx, kar, kdr);
|
||||
sexp_immutablep(res) = sexp_immutablep(x);
|
||||
} else {
|
||||
res = x;
|
||||
}
|
||||
|
@ -1497,6 +1498,8 @@ sexp sexp_vm (sexp ctx, sexp proc) {
|
|||
case OP_VECTOR_SET:
|
||||
if (! sexp_vectorp(_ARG1))
|
||||
sexp_raise("vector-set!: not a vector", sexp_list1(ctx, _ARG1));
|
||||
else if (sexp_immutablep(_ARG1))
|
||||
sexp_raise("vector-set!: immutable vector", sexp_list1(ctx, _ARG1));
|
||||
sexp_vector_set(_ARG1, _ARG2, _ARG3);
|
||||
_ARG3 = SEXP_VOID;
|
||||
top-=2;
|
||||
|
@ -1509,6 +1512,11 @@ sexp sexp_vm (sexp ctx, sexp proc) {
|
|||
top--;
|
||||
break;
|
||||
case OP_STRING_SET:
|
||||
if (! sexp_stringp(_ARG1))
|
||||
sexp_raise("string-set!: not a string", sexp_list1(ctx, _ARG1));
|
||||
else if (sexp_immutablep(_ARG1))
|
||||
sexp_raise("string-set!: immutable string", sexp_list1(ctx, _ARG1));
|
||||
fprintf(stderr, "string-set! %p (immutable: %d)\n", _ARG1, sexp_immutablep(_ARG1));
|
||||
sexp_string_set(_ARG1, _ARG2, _ARG3);
|
||||
_ARG3 = SEXP_VOID;
|
||||
top-=2;
|
||||
|
@ -1557,6 +1565,8 @@ sexp sexp_vm (sexp ctx, sexp proc) {
|
|||
case OP_SET_CAR:
|
||||
if (! sexp_pairp(_ARG1))
|
||||
sexp_raise("set-car!: not a pair", sexp_list1(ctx, _ARG1));
|
||||
else if (sexp_immutablep(_ARG1))
|
||||
sexp_raise("set-car!: immutable pair", sexp_list1(ctx, _ARG1));
|
||||
sexp_car(_ARG1) = _ARG2;
|
||||
_ARG2 = SEXP_VOID;
|
||||
top--;
|
||||
|
@ -1564,6 +1574,8 @@ sexp sexp_vm (sexp ctx, sexp proc) {
|
|||
case OP_SET_CDR:
|
||||
if (! sexp_pairp(_ARG1))
|
||||
sexp_raise("set-cdr!: not a pair", sexp_list1(ctx, _ARG1));
|
||||
else if (sexp_immutablep(_ARG1))
|
||||
sexp_raise("set-cdr!: immutable pair", sexp_list1(ctx, _ARG1));
|
||||
sexp_cdr(_ARG1) = _ARG2;
|
||||
_ARG2 = SEXP_VOID;
|
||||
top--;
|
||||
|
|
|
@ -286,6 +286,7 @@ void *sexp_realloc(sexp ctx, sexp x, size_t size);
|
|||
|
||||
#define sexp_pointer_tag(x) ((x)->tag)
|
||||
#define sexp_gc_mark(x) ((x)->gc_mark)
|
||||
#define sexp_immutablep(x) ((x)->immutablep)
|
||||
|
||||
#define sexp_check_tag(x,t) (sexp_pointerp(x) && (sexp_pointer_tag(x) == (t)))
|
||||
|
||||
|
|
13
sexp.c
13
sexp.c
|
@ -894,9 +894,10 @@ void sexp_write (sexp ctx, sexp obj, sexp out) {
|
|||
else if (obj == sexp_make_character('\t'))
|
||||
sexp_write_string(ctx, "#\\tab", out);
|
||||
else if ((33 <= sexp_unbox_character(obj))
|
||||
&& (sexp_unbox_character(obj) < 127))
|
||||
&& (sexp_unbox_character(obj) < 127)) {
|
||||
sexp_write_string(ctx, "#\\", out);
|
||||
sexp_write_char(ctx, sexp_unbox_character(obj), out);
|
||||
else {
|
||||
} else {
|
||||
sexp_write_string(ctx, "#\\x", out);
|
||||
sexp_write_char(ctx, hex_digit(sexp_unbox_character(obj)>>4), out);
|
||||
sexp_write_char(ctx, hex_digit(sexp_unbox_character(obj)&0xF), out);
|
||||
|
@ -1156,9 +1157,13 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
|
|||
res = sexp_read_error(ctx, "missing trailing ')'", SEXP_NULL, in);
|
||||
}
|
||||
}
|
||||
if ((line >= 0) && sexp_pairp(res))
|
||||
if ((line >= 0) && sexp_pairp(res)) {
|
||||
sexp_pair_source(res)
|
||||
= sexp_cons(ctx, sexp_port_name(in), sexp_make_integer(line));
|
||||
}
|
||||
if (sexp_port_sourcep(in))
|
||||
for (tmp=res; sexp_pairp(tmp); tmp=sexp_cdr(tmp))
|
||||
sexp_immutablep(tmp) = 1;
|
||||
break;
|
||||
case '#':
|
||||
switch (c1=sexp_read_char(ctx, in)) {
|
||||
|
@ -1296,6 +1301,8 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
|
|||
break;
|
||||
}
|
||||
|
||||
if (sexp_port_sourcep(in) && sexp_pointerp(res))
|
||||
sexp_immutablep(res) = 1;
|
||||
sexp_gc_release(ctx, res, s_res);
|
||||
return res;
|
||||
}
|
||||
|
|
Loading…
Add table
Reference in a new issue