static void
syntax_error (const char* const msg, const SCM form, const SCM expr)
{
SCM msg_string = scm_from_locale_string (msg);
SCM filename = SCM_BOOL_F;
SCM linenr = SCM_BOOL_F;
const char *format;
SCM args;
if (scm_is_pair (form))
{
filename = scm_source_property (form, scm_sym_filename);
linenr = scm_source_property (form, scm_sym_line);
}
if (scm_is_false (filename) && scm_is_false (linenr) && scm_is_pair (expr))
{
filename = scm_source_property (expr, scm_sym_filename);
linenr = scm_source_property (expr, scm_sym_line);
}
if (!SCM_UNBNDP (expr))
{
if (scm_is_true (filename))
{
format = "In file ~S, line ~S: ~A ~S in expression ~S.";
args = scm_list_5 (filename, linenr, msg_string, form, expr);
}
else if (scm_is_true (linenr))
{
format = "In line ~S: ~A ~S in expression ~S.";
args = scm_list_4 (linenr, msg_string, form, expr);
}
else
{
format = "~A ~S in expression ~S.";
args = scm_list_3 (msg_string, form, expr);
}
}
else
{
if (scm_is_true (filename))
{
format = "In file ~S, line ~S: ~A ~S.";
args = scm_list_4 (filename, linenr, msg_string, form);
}
else if (scm_is_true (linenr))
{
format = "In line ~S: ~A ~S.";
args = scm_list_3 (linenr, msg_string, form);
}
else
{
format = "~A ~S.";
args = scm_list_2 (msg_string, form);
}
}
scm_error (syntax_error_key, "memoization", format, args, SCM_BOOL_F);
}
/*!
* \brief Get the name of the RC filename being evaluated.
* \par Function Description
*
* Creates a Guile stack object, extracts the topmost frame from that
* stack and gets the sourcefile name.
*
* \returns If the interpreter can resolve the filename, returns a
* Scheme object with the full path to the RC file, otherwise #f
*/
SCM
g_rc_rc_filename()
{
SCM stack, frame, source;
stack = scm_make_stack (SCM_BOOL_T, SCM_EOL);
if (scm_is_false (stack)) {
return SCM_BOOL_F;
}
frame = scm_stack_ref (stack, scm_from_int(0));
if (scm_is_false (frame)) {
return SCM_BOOL_F;
}
source = scm_frame_source (frame);
if (scm_is_false (source)) {
return SCM_BOOL_F;
}
return scm_source_property (source, scm_sym_filename);
}
