[email protected] writes:
> s7_define_function returns an unsafe function (there's
> s7_define_safe_function
> for the safe case), but s7_define_typed_function returns a safe
> function. This
I didn't know about safe/unsafe functions. Using
s7_define_unsafe_typed_function when the function calls s7_values
stops the segfault in the contrived wrapper however to use it in
my own code required the patch below to define functions in the
current let rather than the root let. Actually I only needed to
change the two s7_define_(unsafe)_typed_function as they're all I
use so far but it seemed sensible to change them all.
I'm not sure if there's a good reason to always define the functions
in the root let regardless. As far as I can tell either you'll be
defining the functions during initialisation when you've not left
the root let yet, or you'll have carefully contrived to be in the
let you want them defined in (as I have).
Perhaps it would be better to have _with_environment variants instead
à la s7_load?
> maybe that's the way to clean this up -- assume unsafe etc. This issue
> came up earlier, and I thought I had found a way to notice in s7 that a
> function declared safe was calling something unsafe and warn the user
That would be my preference, to assume C code can and will do
anything until the programmer has declared that it won't, after
which if you get that wrong that's your problem. You've specified
that the compiler/interpreter can bypass some of its sanity checks
so you'll be on the lookout for insanity.
I currently don't declare any functions safe, everything uses
s7_define_unsafe_typed_function, and the tests I've run so far have
not been noticably slow but they have also, and this is important,
not grabbed arguments from the next expression that hasn't been
evaluated yet or crashed when I insert comments. And of course
s7_values works correctly now.
So in my opinion it is better to be unsafe than sorry.
> (s7_eval,
> s7_apply_function, s7_values, and s7_eval_c_string are the culprits),
Presumably s7_load* too as they could do anything. And surely more? s7_call?
Matthew
diff --git a/s7.c b/s7.c
index 363caf3..ffb5def 100644
--- a/s7.c
+++ b/s7.c
@@ -48065,7 +48065,7 @@ s7_pointer s7_define_function(s7_scheme *sc, const char
*name, s7_function fnc,
{
s7_pointer func = s7_make_function(sc, name, fnc, required_args,
optional_args, rest_arg, doc);
s7_pointer sym = T_Sym(c_function_symbol(func));
- s7_define(sc, sc->rootlet, sym, func);
+ s7_define(sc, sc->curlet, sym, func);
return(sym);
}
@@ -48075,7 +48075,7 @@ s7_pointer s7_define_safe_function(s7_scheme *sc, const
char *name, s7_function
/* returns (string->symbol name), not the c_proc_t func */
s7_pointer func = s7_make_safe_function(sc, name, fnc, required_args,
optional_args, rest_arg, doc);
s7_pointer sym = T_Sym(c_function_symbol(func));
- s7_define(sc, sc->rootlet, sym, func);
+ s7_define(sc, sc->curlet, sym, func);
return(sym);
}
@@ -48086,7 +48086,7 @@ s7_pointer s7_define_typed_function(s7_scheme *sc,
const char *name, s7_function
/* returns (string->symbol name), not the c_proc_t func */
s7_pointer func = s7_make_typed_function(sc, name, fnc, required_args,
optional_args, rest_arg, doc, signature); /* includes "safe" bit */
s7_pointer sym = T_Sym(c_function_symbol(func));
- s7_define(sc, sc->rootlet, sym, func);
+ s7_define(sc, sc->curlet, sym, func);
c_function_set_marker(func, NULL);
return(sym);
}
@@ -48098,7 +48098,7 @@ static s7_pointer define_bool_function(s7_scheme *sc,
const char *name, s7_funct
{
const s7_pointer func = s7_make_typed_function(sc, name, fnc, 1,
optional_args, false, doc, signature); /* includes "safe" bit */
const s7_pointer sym = T_Sym(c_function_symbol(func));
- s7_define(sc, sc->rootlet, sym, func);
+ s7_define(sc, sc->curlet, sym, func);
/* if (sym_to_type != T_FREE) */ symbol_set_type(sym, sym_to_type);
symbol_set_category(sym, category);
c_function_set_marker(func, marker);
@@ -48121,7 +48121,7 @@ s7_pointer s7_define_unsafe_typed_function(s7_scheme
*sc, const char *name, s7_f
s7_pointer func = s7_make_function(sc, name, fnc, required_args,
optional_args, rest_arg, doc);
s7_pointer sym = T_Sym(c_function_symbol(func));
if (signature) c_function_set_signature(func, signature);
- s7_define(sc, sc->rootlet, sym, func);
+ s7_define(sc, sc->curlet, sym, func);
return(sym);
}
@@ -48133,7 +48133,7 @@ s7_pointer s7_define_semisafe_typed_function(s7_scheme
*sc, const char *name, s7
s7_pointer sym = T_Sym(c_function_symbol(func));
if (signature) c_function_set_signature(func, signature);
set_is_semisafe(func);
- s7_define(sc, sc->rootlet, sym, func);
+ s7_define(sc, sc->curlet, sym, func);
return(sym);
}
@@ -48232,7 +48232,7 @@ static void define_function_star_1(s7_scheme *sc, const
char *name, s7_function
if (safe)
func = s7_make_safe_function_star(sc, name, fnc, arglist, doc);
else func = s7_make_function_star(sc, name, fnc, arglist, doc);
- s7_define(sc, sc->rootlet, make_symbol_with_strlen(sc, name), func); /*
can't use c_function_symbol here (clobbered by c_function* args) */
+ s7_define(sc, sc->curlet, make_symbol_with_strlen(sc, name), func); /* can't
use c_function_symbol here (clobbered by c_function* args) */
if (signature) c_function_set_signature(func, signature);
}
@@ -48258,7 +48258,7 @@ s7_pointer s7_define_macro(s7_scheme *sc, const char
*name, s7_function fnc,
s7_pointer func = s7_make_function(sc, name, fnc, required_args,
optional_args, rest_arg, doc);
s7_pointer sym = T_Sym(c_function_symbol(func));
set_full_type(func, T_C_MACRO | T_DONT_EVAL_ARGS | T_UNHEAP); /*
s7_make_function includes T_UNHEAP */
- s7_define(sc, sc->rootlet, sym, func);
+ s7_define(sc, sc->curlet, sym, func);
return(sym);
}
@@ -48268,7 +48268,7 @@ s7_pointer s7_define_expansion(s7_scheme *sc, const
char *name, s7_function fnc,
s7_pointer func = s7_make_function(sc, name, fnc, required_args,
optional_args, rest_arg, doc);
s7_pointer sym = T_Sym(c_function_symbol(func));
set_full_type(func, T_C_MACRO | T_EXPANSION | T_DONT_EVAL_ARGS | T_UNHEAP);
/* s7_make_function includes T_UNHEAP */
- s7_define(sc, sc->rootlet, sym, func);
+ s7_define(sc, sc->curlet, sym, func);
set_full_type(sym, full_type(sym) | T_EXPANSION);
return(sym);
}
_______________________________________________
Cmdist mailing list
[email protected]
https://cm-mail.stanford.edu/mailman/listinfo/cmdist
