static SCM ppscm_search_pp_list (SCM list, SCM value) { SCM orig_list = list; if (scm_is_null (list)) return SCM_BOOL_F; if (gdbscm_is_false (scm_list_p (list))) /* scm_is_pair? */ { return ppscm_make_pp_type_error_exception (_("pretty-printer list is not a list"), list); } for ( ; scm_is_pair (list); list = scm_cdr (list)) { SCM matcher = scm_car (list); SCM worker; pretty_printer_smob *pp_smob; if (!ppscm_is_pretty_printer (matcher)) { return ppscm_make_pp_type_error_exception (_("pretty-printer list contains non-pretty-printer object"), matcher); } pp_smob = (pretty_printer_smob *) SCM_SMOB_DATA (matcher); /* Skip if disabled. */ if (gdbscm_is_false (pp_smob->enabled)) continue; if (!gdbscm_is_procedure (pp_smob->lookup)) { return ppscm_make_pp_type_error_exception (_("invalid lookup object in pretty-printer matcher"), pp_smob->lookup); } worker = gdbscm_safe_call_2 (pp_smob->lookup, matcher, value, gdbscm_memory_error_p); if (!gdbscm_is_false (worker)) { if (gdbscm_is_exception (worker)) return worker; if (ppscm_is_pretty_printer_worker (worker)) return worker; return ppscm_make_pp_type_error_exception (_("invalid result from pretty-printer lookup"), worker); } } if (!scm_is_null (list)) { return ppscm_make_pp_type_error_exception (_("pretty-printer list is not a list"), orig_list); } return SCM_BOOL_F; }
SCM scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM alist) { if (!SCM_UNBNDP (filename)) { SCM old_alist = alist; /* have to extract the acons, and operate on that, for thread safety. */ SCM last_acons = SCM_CDR (scm_last_alist_filename); if (scm_is_null (old_alist) && scm_is_eq (SCM_CDAR (last_acons), filename)) { alist = last_acons; } else { alist = scm_acons (scm_sym_filename, filename, alist); if (scm_is_null (old_alist)) scm_set_cdr_x (scm_last_alist_filename, alist); } } SCM_RETURN_NEWSMOB3 (scm_tc16_srcprops, SRCPROPMAKPOS (line, col), SCM_UNPACK (copy), SCM_UNPACK (alist)); }
static SCM expand_cond_clauses (SCM clause, SCM rest, int elp, int alp, SCM env) { SCM test; const long length = scm_ilength (clause); ASSERT_SYNTAX (length >= 1, s_bad_cond_clause, clause); test = CAR (clause); if (scm_is_eq (test, scm_sym_else) && elp) { const int last_clause_p = scm_is_null (rest); ASSERT_SYNTAX (length >= 2, s_bad_cond_clause, clause); ASSERT_SYNTAX (last_clause_p, s_misplaced_else_clause, clause); return expand_sequence (CDR (clause), env); } if (scm_is_null (rest)) rest = VOID (SCM_BOOL_F); else rest = expand_cond_clauses (CAR (rest), CDR (rest), elp, alp, env); if (length >= 2 && scm_is_eq (CADR (clause), scm_sym_arrow) && alp) { SCM tmp = scm_gensym (scm_from_locale_string ("cond ")); SCM new_env = scm_acons (tmp, tmp, env); ASSERT_SYNTAX (length > 2, s_missing_recipient, clause); ASSERT_SYNTAX (length == 3, s_extra_expression, clause); return LET (SCM_BOOL_F, scm_list_1 (tmp), scm_list_1 (tmp), scm_list_1 (expand (test, env)), CONDITIONAL (SCM_BOOL_F, LEXICAL_REF (SCM_BOOL_F, tmp, tmp), CALL (SCM_BOOL_F, expand (CADDR (clause), new_env), scm_list_1 (LEXICAL_REF (SCM_BOOL_F, tmp, tmp))), rest)); } /* FIXME length == 1 case */ else return CONDITIONAL (SCM_BOOL_F, expand (test, env), expand_sequence (CDR (clause), env), rest); }
static SCM expand_let (SCM expr, SCM env) { SCM bindings; const SCM cdr_expr = CDR (expr); const long length = scm_ilength (cdr_expr); ASSERT_SYNTAX (length >= 0, s_bad_expression, expr); ASSERT_SYNTAX (length >= 2, s_missing_expression, expr); bindings = CAR (cdr_expr); if (scm_is_symbol (bindings)) { ASSERT_SYNTAX (length >= 3, s_missing_expression, expr); return expand_named_let (expr, env); } check_bindings (bindings, expr); if (scm_is_null (bindings)) return expand_sequence (CDDR (expr), env); else { SCM var_names, var_syms, inits; transform_bindings (bindings, expr, &var_names, &var_syms, &inits); return LET (SCM_BOOL_F, var_names, var_syms, expand_exprs (inits, env), expand_sequence (CDDR (expr), expand_env_extend (env, var_names, var_syms))); } }
static SCM decode_scm_col_list (GttGhtml *ghtml, SCM col_list) { SCM col_name; char * tok = NULL; /* reset the parser */ ghtml->ninvl_cols = 0; ghtml->ntask_cols = 0; while (!scm_is_null (col_list)) { col_name = SCM_CAR (col_list); /* either a 'symbol or a "quoted string" */ if (!scm_is_symbol(col_name) && !scm_is_string (col_name)) { col_list = SCM_CDR (col_list); continue; } tok = scm_to_locale_string (col_name); decode_column (ghtml, tok); free (tok); col_list = SCM_CDR (col_list); } return SCM_UNSPECIFIED; }
GList * gnc_scm_list_to_glist(SCM rest) { GList *result = NULL; SCM scm_item; SWIG_GetModule(NULL); /* Work-around for SWIG bug. */ SCM_ASSERT(scm_is_list(rest), rest, SCM_ARG1, "gnc_scm_list_to_glist"); while (!scm_is_null(rest)) { void *item; scm_item = SCM_CAR(rest); rest = SCM_CDR(rest); if (scm_item == SCM_BOOL_F) { result = g_list_prepend(result, NULL); } else { if (!SWIG_IsPointer(scm_item)) scm_misc_error("gnc_scm_list_to_glist", "Item in list not a wcp.", scm_item); item = (void *)SWIG_PointerAddress(scm_item); result = g_list_prepend(result, item); } } return g_list_reverse(result); }
static SCM expand_and (SCM expr, SCM env) { const SCM cdr_expr = CDR (expr); if (scm_is_null (cdr_expr)) return CONST (SCM_BOOL_F, SCM_BOOL_T); ASSERT_SYNTAX (scm_is_pair (cdr_expr), s_bad_expression, expr); if (scm_is_null (CDR (cdr_expr))) return expand (CAR (cdr_expr), env); else return CONDITIONAL (scm_source_properties (expr), expand (CAR (cdr_expr), env), expand_and (cdr_expr, env), CONST (SCM_BOOL_F, SCM_BOOL_F)); }
static SCM expand_exprs (SCM forms, const SCM env) { SCM ret = SCM_EOL; for (; !scm_is_null (forms); forms = CDR (forms)) ret = scm_cons (expand (CAR (forms), env), ret); return scm_reverse_x (ret, SCM_UNDEFINED); }
/******************************************************************** * update_report_list * * this procedure does the real work of displaying a sorted list of * available custom reports ********************************************************************/ static void update_report_list(GtkListStore *store, CustomReportDialog *crd) { SCM get_rpt_guids = scm_c_eval_string("gnc:custom-report-template-guids"); SCM template_menu_name = scm_c_eval_string("gnc:report-template-menu-name/report-guid"); SCM rpt_guids; int i; GtkTreeIter iter; GtkTreeModel *model = GTK_TREE_MODEL (store); gboolean valid_iter; gtk_tree_sortable_set_sort_column_id(GTK_TREE_SORTABLE(store), COL_NAME, GTK_SORT_ASCENDING); crd->reportlist = scm_call_0(get_rpt_guids); rpt_guids = crd->reportlist; /* Empty current liststore */ valid_iter = gtk_tree_model_get_iter_first (model, &iter); while (valid_iter) { GValue value = { 0, }; GncGUID *row_guid; g_value_init ( &value, G_TYPE_POINTER); gtk_tree_model_get_value (model, &iter, COL_NUM, &value); row_guid = (GncGUID *) g_value_get_pointer (&value); guid_free (row_guid); g_value_unset (&value); valid_iter = gtk_tree_model_iter_next (model, &iter); } gtk_list_store_clear(store); if (scm_is_list(rpt_guids)) { /* for all the report guids in the list, store them, with a reference, in the gtkliststore */ for (i = 0; !scm_is_null(rpt_guids); i++) { GncGUID *guid = guid_malloc (); gchar *guid_str = scm_to_utf8_string (SCM_CAR(rpt_guids)); gchar *name = gnc_scm_to_utf8_string (scm_call_2(template_menu_name, SCM_CAR(rpt_guids), SCM_BOOL_F)); if (string_to_guid (guid_str, guid)) { gtk_list_store_append(store, &iter); gtk_list_store_set(store, &iter, COL_NAME, name, COL_NUM, guid, -1); } g_free (name); g_free (guid_str); rpt_guids = SCM_CDR(rpt_guids); } } }
static SCM expand_sequence (const SCM forms, const SCM env) { ASSERT_SYNTAX (scm_ilength (forms) >= 1, s_bad_expression, scm_cons (scm_sym_begin, forms)); if (scm_is_null (CDR (forms))) return expand (CAR (forms), env); else return SEQ (scm_source_properties (forms), expand (CAR (forms), env), expand_sequence (CDR (forms), env)); }
/*! \brief Re-poll a scheme procedure for symbols. * \par Function Description * Calls a Scheme procedure to obtain a list of available symbols, * and updates the source with the new list * * Private function used only in s_clib.c. */ static void refresh_scm (CLibSource *source) { SCM symlist; SCM symname; CLibSymbol *symbol; char *tmp; g_return_if_fail (source != NULL); g_return_if_fail (source->type == CLIB_SCM); /* Clear the current symbol list */ g_list_foreach (source->symbols, (GFunc) free_symbol, NULL); g_list_free (source->symbols); source->symbols = NULL; symlist = scm_call_0 (source->list_fn); if (scm_is_false (scm_list_p (symlist))) { s_log_message (_("Failed to scan library [%1$s]: Scheme function returned non-list."), source->name); return; } while (!scm_is_null (symlist)) { symname = SCM_CAR (symlist); if (!scm_is_string (symname)) { s_log_message (_("Non-string symbol name while scanning library [%1$s]"), source->name); } else { symbol = g_new0 (CLibSymbol, 1); symbol->source = source; /* Need to make sure that the correct free() function is called * on strings allocated by Guile. */ tmp = scm_to_utf8_string (symname); symbol->name = g_strdup(tmp); free (tmp); /* Prepend because it's faster and it doesn't matter what order we * add them. */ source->symbols = g_list_prepend (source->symbols, symbol); } symlist = SCM_CDR (symlist); } /* Now sort the list of symbols by name. */ source->symbols = g_list_sort (source->symbols, (GCompareFunc) compare_symbol_name); s_clib_flush_search_cache(); s_clib_flush_symbol_cache(); }
static void gnc_style_sheet_select_dialog_fill(StyleSheetDialog * ss) { SCM stylesheets = scm_c_eval_string("(gnc:get-html-style-sheets)"); SCM sheet_info; /* pack it full of content */ for (; !scm_is_null(stylesheets); stylesheets = SCM_CDR(stylesheets)) { sheet_info = SCM_CAR(stylesheets); gnc_style_sheet_select_dialog_add_one(ss, sheet_info, FALSE); } }
static int more_specificp (SCM m1, SCM m2, SCM const *targs) { register SCM s1, s2; register long i; /* * Note: * m1 and m2 can have != length (i.e. one can be one element longer than the * other when we have a dotted parameter list). For instance, with the call * (M 1) * with * (define-method M (a . l) ....) * (define-method M (a) ....) * * we consider that the second method is more specific. * * BTW, targs is an array of types. We don't need it's size since * we already know that m1 and m2 are applicable (no risk to go past * the end of this array). * */ for (i=0, s1=SPEC_OF(m1), s2=SPEC_OF(m2); ; i++, s1=SCM_CDR(s1), s2=SCM_CDR(s2)) { if (scm_is_null(s1)) return 1; if (scm_is_null(s2)) return 0; if (!scm_is_eq (SCM_CAR(s1), SCM_CAR(s2))) { register SCM l, cs1 = SCM_CAR(s1), cs2 = SCM_CAR(s2); for (l = CPL_OF (targs[i]); ; l = SCM_CDR(l)) { if (scm_is_eq (cs1, SCM_CAR (l))) return 1; if (scm_is_eq (cs2, SCM_CAR (l))) return 0; } return 0;/* should not occur! */ } } return 0; /* should not occur! */ }
int scm_list_to_imht_set(SCM scm_a, imht_set_t **result) { int a_length = scm_to_uint32((scm_length(scm_a))); if (!imht_set_create((3 + a_length), result)) { return (1); }; while (!scm_is_null(scm_a)) { if (!imht_set_add((*result), (scm_to_int((SCM_CAR(scm_a)))))) { imht_set_destroy((*result)); return (2); }; scm_a = SCM_CDR(scm_a); }; return (0); };
int scm_is_alist(SCM x) { SCM item; if (!scm_is_list(x)) return 0; while (!scm_is_null(x)) { item = SCM_CAR(x); if (!scm_is_pair(item)) return 0; x = SCM_CDR(x); } return 1; }
/************************************************************** * custom_report_run_report * * this procedure sets up and calls the report on the scheme * side. This is what makes the report actually run. **************************************************************/ static void custom_report_edit_report_name (SCM guid, CustomReportDialog *crd, gchar *new_name) { SCM rename_report = scm_c_eval_string("gnc:rename-report"); SCM new_name_scm = scm_from_utf8_string(new_name); if (scm_is_null(guid) || !new_name || (*new_name == '\0')) return; /* rename the report */ scm_call_2(rename_report, guid, new_name_scm); update_report_list(GTK_LIST_STORE(gtk_tree_view_get_model(GTK_TREE_VIEW(crd->reportview))), crd); }
static SCM expand (SCM exp, SCM env) { if (scm_is_pair (exp)) { SCM car; scm_t_macro_primitive trans = NULL; SCM macro = SCM_BOOL_F; car = CAR (exp); if (scm_is_symbol (car)) macro = expand_env_ref_macro (env, car); if (scm_is_true (macro)) trans = scm_i_macro_primitive (macro); if (trans) return trans (exp, env); else { SCM arg_exps = SCM_EOL; SCM args = SCM_EOL; SCM proc = CAR (exp); for (arg_exps = CDR (exp); scm_is_pair (arg_exps); arg_exps = CDR (arg_exps)) args = scm_cons (expand (CAR (arg_exps), env), args); if (scm_is_null (arg_exps)) return CALL (scm_source_properties (exp), expand (proc, env), scm_reverse_x (args, SCM_UNDEFINED)); else syntax_error ("expected a proper list", exp, SCM_UNDEFINED); } } else if (scm_is_symbol (exp)) { SCM gensym = expand_env_lexical_gensym (env, exp); if (scm_is_true (gensym)) return LEXICAL_REF (SCM_BOOL_F, exp, gensym); else return TOPLEVEL_REF (SCM_BOOL_F, exp); } else return CONST (SCM_BOOL_F, exp); }
void custom_report_name_edited_cb(GtkCellRendererText *renderer, gchar *path, gchar *new_text, gpointer data) { CustomReportDialog *crd = data; SCM guid = get_custom_report_selection(crd, _("Unable to change report configuration name.")); SCM unique_name_func = scm_c_eval_string("gnc:report-template-has-unique-name?"); SCM new_name_scm = scm_from_utf8_string(new_text); g_object_set(G_OBJECT(crd->namerenderer), "editable", FALSE, NULL); if (scm_is_null (guid)) return; if (scm_is_true (scm_call_2 (unique_name_func, guid, new_name_scm))) custom_report_edit_report_name (guid, crd, new_text); else gnc_error_dialog (GTK_WINDOW (crd->dialog), "%s", _("A saved report configuration with this name already exists, please choose another name.") ); }
static SCM pg_map_rows(SCM res, SCM rest) { struct pg_res *pgr; SCM bag, row; scm_assert_smob_type(pg_res_tag, res); bag = row = SCM_EOL; pgr = (struct pg_res *)SCM_SMOB_DATA(res); while (pgr->cursor < pgr->tuples) { row = build_row(pgr); if (!scm_is_null(rest)) bag = scm_cons(scm_call_1(SCM_CAR(rest), row), bag); else bag = scm_cons(row, bag); pgr->cursor++; } PQclear(pgr->res); pgr->res = NULL; bag = scm_reverse(bag); scm_remember_upto_here_2(bag, row); scm_remember_upto_here_2(res, rest); return bag; }
/********************************************************************* * custom_report_delete * * this will delete the report, update the reports list and leave the * dialog active for additional usage. *********************************************************************/ static void custom_report_delete (SCM guid, CustomReportDialog *crd) { SCM template_menu_name = scm_c_eval_string("gnc:report-template-menu-name/report-guid"); gchar *report_name; if (scm_is_null (guid)) return; report_name = gnc_scm_to_utf8_string(scm_call_2(template_menu_name, guid, SCM_BOOL_F)); /* we must confirm the user wants to delete their precious custom report! */ if (gnc_verify_dialog( GTK_WINDOW (crd->dialog), FALSE, _("Are you sure you want to delete %s?"), report_name)) { SCM del_report = scm_c_eval_string("gnc:delete-report"); scm_call_1(del_report, guid); update_report_list(GTK_LIST_STORE(gtk_tree_view_get_model(GTK_TREE_VIEW(crd->reportview))), crd); } g_free (report_name); }
/* Check if the format of the bindings is ((<symbol> <init-form>) ...). */ static void check_bindings (const SCM bindings, const SCM expr) { SCM binding_idx; ASSERT_SYNTAX_2 (scm_ilength (bindings) >= 0, s_bad_bindings, bindings, expr); binding_idx = bindings; for (; !scm_is_null (binding_idx); binding_idx = CDR (binding_idx)) { SCM name; /* const */ const SCM binding = CAR (binding_idx); ASSERT_SYNTAX_2 (scm_ilength (binding) == 2, s_bad_binding, binding, expr); name = CAR (binding); ASSERT_SYNTAX_2 (scm_is_symbol (name), s_bad_variable, name, expr); } }
GSList * gnc_scm_to_gslist_string(SCM list) { GSList *gslist = NULL; while (!scm_is_null (list)) { if (scm_is_string(SCM_CAR(list))) { gchar * str; str = gnc_scm_to_locale_string (SCM_CAR(list)); if (str) gslist = g_slist_prepend (gslist, g_strdup (str)); g_free (str); } list = SCM_CDR (list); } return g_slist_reverse (gslist); }
SCM scm_find_method (SCM l) #define FUNC_NAME "find-method" { SCM gf; long len = scm_ilength (l); if (len == 0) SCM_WRONG_NUM_ARGS (); scm_c_issue_deprecation_warning ("scm_find_method is deprecated. Use `compute-applicable-methods' " "from Scheme instead."); gf = SCM_CAR(l); l = SCM_CDR(l); SCM_VALIDATE_GENERIC (1, gf); if (scm_is_null (scm_slot_ref (gf, scm_from_latin1_symbol ("methods")))) SCM_MISC_ERROR ("no methods for generic ~S", scm_list_1 (gf)); return scm_compute_applicable_methods (gf, l, len - 1, 1); }
/************************************************************** * custom_report_run_report * * this procedure sets up and calls the report on the scheme * side. This is what makes the report actually run. **************************************************************/ static void custom_report_run_report(SCM guid, CustomReportDialog *crd) { SCM make_report = scm_c_eval_string("gnc:make-report"); int report_id; GncMainWindow *window = crd->window; if (scm_is_null(guid)) return; /* this generates the report */ report_id = scm_to_int (scm_call_1(make_report, guid)); /* do this *before* displaying the report because sometimes that takes a while... */ custom_report_dialog_close_cb(NULL, crd); /* display the report */ gnc_main_window_open_report(report_id, window); }
/* * Recursive routine. It calls itself for list values and calls * "do_substitution" for string values. Each substitution will * be done in the order found in the tree walk of list values. * The "match" and "repl" trees *must* be identical in structure. */ LOCAL void do_multi_subs(char ** ppzStr, ssize_t * pStrLen, SCM match, SCM repl) { char * pzStr = *ppzStr; char * pzNxt = pzStr; /* * Loop for as long as our list has more entries */ while (! scm_is_null(match)) { /* * "CAR" is the current value, "CDR" is rest of list */ SCM matchCar = SCM_CAR(match); SCM replCar = SCM_CAR(repl); match = SCM_CDR(match); repl = SCM_CDR(repl); if (AG_SCM_STRING_P(matchCar)) { do_substitution(pzStr, *pStrLen, matchCar, replCar, &pzNxt, pStrLen); // coverity[use_after_free] -- invalid alias analysis pzStr = pzNxt; } else if (AG_SCM_LIST_P(matchCar)) do_multi_subs(&pzStr, pStrLen, matchCar, replCar); else /* * Whatever it is it is not part of what we would expect. Bail. */ break; } *ppzStr = pzStr; }
static SCM expand_letstar_clause (SCM bindings, SCM body, SCM env SCM_UNUSED) { if (scm_is_null (bindings)) return expand_sequence (body, env); else { SCM bind, name, sym, init; ASSERT_SYNTAX (scm_is_pair (bindings), s_bad_expression, bindings); bind = CAR (bindings); ASSERT_SYNTAX (scm_ilength (bind) == 2, s_bad_binding, bind); name = CAR (bind); sym = scm_gensym (SCM_UNDEFINED); init = CADR (bind); return LET (SCM_BOOL_F, scm_list_1 (name), scm_list_1 (sym), scm_list_1 (expand (init, env)), expand_letstar_clause (CDR (bindings), body, scm_acons (name, sym, env))); } }
static SCM touch_node(SCM doc, SCM args) { MAKE_NODE *node; node = (MAKE_NODE *)SCM_SMOB_DATA(doc); scm_lock_mutex(node->mutex); invalidate(node); if (scm_is_null(args)) { scm_unlock_mutex(node->mutex); return SCM_BOOL_T; } switch (node->type) { case TYPE_DATUM: node->payload = SCM_CAR(args); break; case TYPE_FILE: free(node->filepath); node->filepath = scm_to_locale_string(SCM_CAR(args)); break; } scm_unlock_mutex(node->mutex); scm_remember_upto_here_2(doc, args); return SCM_BOOL_T; }
static SCM pg_format_sql(SCM conn, SCM obj) { struct pg_conn *pgc; SCM out; if (SCM_SMOB_PREDICATE(time_tag, obj)) { out = format_time(obj, c2s("'%Y-%m-%d %H:%M:%S'")); } else if (scm_boolean_p(obj) == SCM_BOOL_T) { if (scm_is_true(obj)) out = c2s("'t'"); else out = c2s("'f'"); } else if (scm_is_number(obj)) { out = scm_number_to_string(obj, scm_from_signed_integer(10)); } else if (scm_is_symbol(obj)) { out = pg_format_sql(conn, scm_symbol_to_string(obj)); } else if (scm_is_string(obj)) { if (scm_string_null_p(obj) == SCM_BOOL_T) out = c2s("NULL"); else { char *src = scm_to_utf8_string(obj); scm_assert_smob_type(pg_conn_tag, conn); pgc = (struct pg_conn *)SCM_SMOB_DATA(conn); scm_lock_mutex(pgc->mutex); char *sql = PQescapeLiteral(pgc->conn, src, strlen(src)); out = safe_from_utf8(sql); scm_unlock_mutex(pgc->mutex); free(src); PQfreemem(sql); } } else if (scm_is_null(obj)) out = c2s("NULL"); else out = c2s("NULL"); scm_remember_upto_here_1(out); scm_remember_upto_here_2(conn, obj); return out; }
static SCM expand_or (SCM expr, SCM env SCM_UNUSED) { SCM tail = CDR (expr); const long length = scm_ilength (tail); ASSERT_SYNTAX (length >= 0, s_bad_expression, expr); if (scm_is_null (CDR (expr))) return CONST (SCM_BOOL_F, SCM_BOOL_F); else { SCM tmp = scm_gensym (SCM_UNDEFINED); return LET (SCM_BOOL_F, scm_list_1 (tmp), scm_list_1 (tmp), scm_list_1 (expand (CADR (expr), env)), CONDITIONAL (SCM_BOOL_F, LEXICAL_REF (SCM_BOOL_F, tmp, tmp), LEXICAL_REF (SCM_BOOL_F, tmp, tmp), expand_or (CDR (expr), scm_acons (tmp, tmp, env)))); } }
/* The bindings, which must have the format ((v1 i1) (v2 i2) ... (vn in)), are * transformed to the lists (vn .. v2 v1) and (i1 i2 ... in). If a duplicate * variable name is detected, an error is signalled. */ static void transform_bindings (const SCM bindings, const SCM expr, SCM *const names, SCM *const vars, SCM *const initptr) { SCM rnames = SCM_EOL; SCM rvars = SCM_EOL; SCM rinits = SCM_EOL; SCM binding_idx = bindings; for (; !scm_is_null (binding_idx); binding_idx = CDR (binding_idx)) { const SCM binding = CAR (binding_idx); const SCM CDR_binding = CDR (binding); const SCM name = CAR (binding); ASSERT_SYNTAX_2 (scm_is_false (scm_c_memq (name, rnames)), s_duplicate_binding, name, expr); rnames = scm_cons (name, rnames); rvars = scm_cons (scm_gensym (SCM_UNDEFINED), rvars); rinits = scm_cons (CAR (CDR_binding), rinits); } *names = scm_reverse_x (rnames, SCM_UNDEFINED); *vars = scm_reverse_x (rvars, SCM_UNDEFINED); *initptr = scm_reverse_x (rinits, SCM_UNDEFINED); }