Back to index

texmacs  1.0.7.15
guile_tm.hpp
Go to the documentation of this file.
00001 /******************************************************************************
00002  * MODULE     : guile_tm.hpp
00003  * DESCRIPTION: Everything which depends on the version of Guile
00004  *              should be move to this file
00005  * COPYRIGHT  : (C) 1999-2011  Joris van der Hoeven and Massimiliano Gubinelli
00006  *******************************************************************************
00007  * This software falls under the GNU general public license version 3 or later.
00008  * It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE
00009  * in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>.
00010  ******************************************************************************/
00011 
00012 #ifndef GUILE_TM_H
00013 #define GUILE_TM_H
00014 #include "tm_configure.hpp"
00015 
00016 #include "blackbox.hpp"
00017 #include "array.hpp"
00018 
00019 
00020 #ifdef __MINGW32__
00021 // we redefine some symbols to avoid name clashes with Windows headers (included by Guile)
00022 #define PATTERN WIN_PATTERN
00023 #define STRING WIN_STRING
00024 #define GROUP WIN_GROUP
00025 #ifdef IN
00026 #define MY_IN IN
00027 #undef IN
00028 #endif
00029 #ifdef OUT
00030 #define MY_OUT OUT
00031 #undef OUT
00032 #endif
00033 #ifdef MENU_EVENT
00034 #define MY_MENU_EVENT MENU_EVENT
00035 #undef MENU_EVENT
00036 #endif
00037 #endif // __MINGW32__
00038 
00039 #if defined(GUILE_D) || defined(GUILE_C) 
00040 #include <libguile.h>
00041 #else
00042 #include <guile/gh.h>
00043 #endif
00044 
00045 #ifdef __MINGW32__
00046 // put things back
00047 #undef STRING
00048 #undef ERROR
00049 #undef PATTERN
00050 #undef GROUP
00051 #undef IN
00052 #undef OUT
00053 #undef MENU_EVENT
00054 #ifdef MY_MENU_EVENT
00055 #define MENU_EVENT MY_MENU_EVENT
00056 #undef MY_MENU_EVENT
00057 #endif
00058 #ifdef MY_IN
00059 #define IN MY_IN
00060 #undef MY_IN
00061 #endif
00062 #ifdef MY_OUT
00063 #define OUT MY_OUT
00064 #undef MY_OUT
00065 #endif
00066 #endif // __MINGW32__
00067 
00068 #ifdef GUILE_D
00069 
00070 #define SCM_NULL scm_list_n (SCM_UNDEFINED)
00071 #define scm_bool2scm scm_from_bool
00072 #define scm_is_list(x) scm_is_true(scm_list_p(x))
00073 #define scm_scm2bool scm_is_true
00074 #define scm_is_int scm_is_integer
00075 #define scm_is_double scm_is_real
00076 #define scm_new_procedure(name,r,a,b,c) scm_c_define_gsubr(name,a,b,c,(scm_t_subr)r)
00077 #define scm_lookup_string(name) scm_variable_ref(scm_c_lookup(name))
00078 #define scm_long2scm scm_long2num
00079 #define scm_scm2long(x) scm_num2long(x,SCM_ARG1,"scm2long")
00080 #define scm_double2scm scm_from_double
00081 #define scm_scm2double scm_to_double
00082 #define scm_str2scm scm_from_locale_stringn
00083 #define scm_scm2str scm_to_locale_stringn
00084 #define scm_symbol2scm scm_from_locale_symbol
00085 #define scm_scm2symbol(x,y) scm_to_locale_stringn(scm_symbol_to_string(x),y)
00086 
00087 #else
00088 #ifdef GUILE_C
00089 
00090 #define SCM_NULL scm_list_n (SCM_UNDEFINED)
00091 #define scm_bool2scm scm_from_bool
00092 #define scm_is_list(x) scm_is_true(scm_list_p(x))
00093 #define scm_scm2bool scm_is_true
00094 #define scm_is_int scm_is_integer
00095 #define scm_is_double scm_is_real
00096 #define scm_new_procedure(name,r,a,b,c) scm_c_define_gsubr(name,a,b,c,r)
00097 #define scm_lookup_string(name) scm_variable_ref(scm_c_lookup(name))
00098 #define scm_long2scm scm_long2num
00099 #define scm_scm2long(x) scm_num2long(x,SCM_ARG1,"scm2long")
00100 #define scm_double2scm scm_from_double
00101 #define scm_scm2double scm_to_double
00102 #define scm_str2scm scm_from_locale_stringn
00103 #define scm_scm2str scm_to_locale_stringn
00104 #define scm_symbol2scm scm_from_locale_symbol
00105 #define scm_scm2symbol(x,y) scm_to_locale_stringn(scm_symbol_to_string(x),y)
00106 
00107 #else
00108 #ifdef GUILE_B
00109 
00110 #define SCM_NULL scm_list_n (SCM_UNDEFINED)
00111 #define scm_is_list(x) SCM_NFALSEP(scm_list_p(x))
00112 #define scm_new_procedure(name,r,a,b,c) scm_c_define_gsubr(name,a,b,c,r)
00113 #define scm_lookup_string(name) scm_variable_ref(scm_c_lookup(name))
00114 #define scm_long2scm scm_long2num
00115 #define scm_scm2long(x) scm_num2long(x,SCM_ARG1,"scm2long")
00116 
00117 #define scm_is_null(x) SCM_NFALSEP(scm_null_p(x))
00118 #define scm_is_pair(x) SCM_NFALSEP(scm_pair_p(x))
00119 #define scm_is_bool(x) SCM_NFALSEP(scm_boolean_p(x))
00120 #define scm_is_int SCM_INUMP
00121 #define scm_is_double SCM_REALP
00122 #define scm_is_string(obj) (SCM_NIMP(obj) && SCM_STRINGP(obj))
00123 #define scm_is_symbol(x) SCM_NFALSEP(scm_symbol_p(x))
00124 
00125 #define scm_bool2scm SCM_BOOL
00126 #define scm_scm2bool SCM_NFALSEP
00127 #define scm_long2scm scm_long2num
00128 #define scm_scm2long(x) scm_num2long(x,SCM_ARG1,"scm2long")
00129 #define scm_double2scm scm_make_real
00130 #define scm_scm2double(x) scm_num2dbl(x,"scm2double")
00131 #define scm_symbol2scm scm_str2symbol
00132 #define scm_scm2symbol gh_symbol2newstr
00133 
00134 #define scm_str2scm scm_mem2string
00135 #define scm_scm2str gh_scm2newstr
00136 
00137 #else
00138 #ifdef GUILE_A
00139 
00140 #define SCM_NULL gh_list (SCM_UNDEFINED)
00141 #define scm_is_bool gh_boolean_p
00142 #define scm_is_int SCM_INUMP
00143 #define scm_is_double SCM_REALP
00144 #define scm_is_string(obj) (SCM_NIMP(obj) && SCM_STRINGP(obj))
00145 #define scm_is_symbol gh_symbol_p
00146 #define scm_is_null gh_null_p
00147 #define scm_is_pair gh_pair_p
00148 #define scm_is_list gh_list_p
00149 
00150 #define scm_bool2scm gh_bool2scm
00151 #define scm_scm2bool gh_scm2bool
00152 #define scm_long2scm gh_long2scm
00153 #define scm_scm2long gh_scm2long
00154 #define scm_double2scm gh_double2scm
00155 #define scm_scm2double gh_scm2double
00156 #define scm_str2scm gh_str2scm
00157 #define scm_scm2str gh_scm2newstr
00158 #define scm_symbol2scm gh_symbol2scm
00159 #define scm_scm2symbol gh_symbol2newstr
00160 
00161 #define scm_c_primitive_load gh_eval_file
00162 #define scm_c_eval_string gh_eval_str
00163 #define scm_apply_0 gh_apply
00164 #define scm_call_0 gh_call0
00165 #define scm_call_1 gh_call1
00166 #define scm_call_2 gh_call2
00167 #define scm_call_3 gh_call3
00168 #define scm_new_procedure gh_new_procedure
00169 #define scm_lookup_string gh_lookup
00170 
00171 typedef SCM (*scm_t_catch_body) (void *data);
00172 typedef SCM (*scm_t_catch_handler) (void *data, SCM tag, SCM throw_args);
00173 
00174 #else
00175 
00176 #error "At least one of the macros GUILE_{A,B,C,D} should be defined" 
00177 
00178 #endif // defined(GUILE_A)
00179 #endif // defined(GUILE_B)
00180 #endif // defined(GUILE_C)
00181 #endif // defined(GUILE_D)
00182 
00183 #define SCM_ARG8 8
00184 #define SCM_ARG9 9
00185 
00186 #ifdef DOTS_OK
00187 typedef SCM (*FN)(...);
00188 #else
00189 typedef SCM (*FN)();
00190 #endif
00191 
00192 #if defined(GUILE_A) || defined(GUILE_B)
00193 int scm_to_bool (SCM obj);
00194 int scm_to_int (SCM obj);
00195 double scm_to_double (SCM i);
00196 #endif
00197 
00198 
00199 typedef SCM tmscm;
00200 
00201 bool tmscm_is_blackbox (tmscm obj);
00202 tmscm blackbox_to_tmscm (blackbox b);
00203 blackbox tmscm_to_blackbox (tmscm obj);
00204 
00205 inline tmscm tmscm_null () { return SCM_NULL; }
00206 inline tmscm tmscm_true () { return SCM_BOOL_T; }
00207 inline tmscm tmscm_false () { return SCM_BOOL_F; }
00208 inline void tmscm_set_car (tmscm a, tmscm b) { SCM_SETCAR(a,b); }
00209 inline void tmscm_set_cdr (tmscm a, tmscm b) { SCM_SETCDR(a,b); }
00210        
00211        
00212 inline bool tmscm_is_equal (tmscm o1, tmscm o2) { return SCM_NFALSEP ( scm_equal_p(o1, o2)); }
00213 
00214 
00215 
00216 inline bool tmscm_is_null (tmscm obj) { return scm_is_null (obj); }
00217 inline bool tmscm_is_pair (tmscm obj) { return scm_is_pair (obj); }
00218 inline bool tmscm_is_list (tmscm obj) { return scm_is_list (obj); }
00219 inline bool tmscm_is_bool (tmscm obj) { return scm_is_bool (obj); }
00220 inline bool tmscm_is_int (tmscm obj) { return scm_is_int (obj); }
00221 inline bool tmscm_is_double (tmscm obj) { return scm_is_double (obj); }
00222 inline bool tmscm_is_string (tmscm obj) { return scm_is_string (obj); }
00223 inline bool tmscm_is_symbol (tmscm obj) { return scm_is_symbol (obj); }
00224 
00225 inline tmscm tmscm_cons (tmscm obj1, tmscm obj2) { return scm_cons (obj1, obj2); }
00226 inline tmscm tmscm_car (tmscm obj) { return SCM_CAR (obj); }
00227 inline tmscm tmscm_cdr (tmscm obj) { return SCM_CDR (obj); }
00228 inline tmscm tmscm_caar (tmscm obj) { return SCM_CAAR (obj); }
00229 inline tmscm tmscm_cadr (tmscm obj) { return SCM_CADR (obj); }
00230 inline tmscm tmscm_cdar (tmscm obj) { return SCM_CDAR (obj); }
00231 inline tmscm tmscm_cddr (tmscm obj) { return SCM_CDDR (obj); }
00232 inline tmscm tmscm_caddr (tmscm obj) { return SCM_CADDR (obj); }
00233 inline tmscm tmscm_cadddr (tmscm obj) { return SCM_CADDDR (obj); }
00234 
00235 
00236 
00237 SCM bool_to_scm (bool b);
00238 SCM int_to_scm (int i);
00239 SCM double_to_scm (double i);
00240 
00241 
00242 
00243 inline tmscm bool_to_tmscm (bool b) { return bool_to_scm (b); }
00244 inline tmscm int_to_tmscm (int i) {   return int_to_scm (i); }
00245 inline tmscm double_to_tmscm (double i) { return double_to_scm (i); }
00246 tmscm string_to_tmscm (string s);
00247 tmscm symbol_to_tmscm (string s);
00248 
00249 inline bool tmscm_to_bool (tmscm obj) { return scm_to_bool (obj); }
00250 inline int tmscm_to_int (tmscm obj) { return scm_to_int (obj); }
00251 inline double tmscm_to_double (tmscm obj) { return scm_to_double (obj); }
00252 string tmscm_to_string (tmscm obj);
00253 string tmscm_to_symbol (tmscm obj);
00254 
00255 
00256 
00257 
00258 tmscm eval_scheme_file (string name);
00259 tmscm eval_scheme (string s);
00260 tmscm call_scheme (tmscm fun);
00261 tmscm call_scheme (tmscm fun, tmscm a1);
00262 tmscm call_scheme (tmscm fun, tmscm a1, tmscm a2);
00263 tmscm call_scheme (tmscm fun, tmscm a1, tmscm a2, tmscm a3);
00264 tmscm call_scheme (tmscm fun, tmscm a1, tmscm a2, tmscm a3, tmscm a4);
00265 tmscm call_scheme (tmscm fun, array<tmscm> a);
00266 
00267 
00268 #define tmscm_install_procedure(name, func, args, p0, p1) \
00269   scm_new_procedure (name, ( FN )( func ), args, p0, p1)
00270 
00271 #define TMSCM_ASSERT(_cond, _arg, _pos, _subr) \
00272  SCM_ASSERT(_cond, _arg, _pos, _subr)
00273 
00274 #define TMSCM_ARG1 SCM_ARG1
00275 #define TMSCM_ARG2 SCM_ARG2
00276 #define TMSCM_ARG3 SCM_ARG3
00277 #define TMSCM_ARG4 SCM_ARG4
00278 #define TMSCM_ARG5 SCM_ARG5
00279 #define TMSCM_ARG6 SCM_ARG6
00280 #define TMSCM_ARG7 SCM_ARG7
00281 #define TMSCM_ARG8 SCM_ARG8
00282 
00283 #define TMSCM_UNSPECIFIED SCM_UNSPECIFIED
00284 
00285 
00286 string scheme_dialect ();
00287 
00288 
00289 #endif // defined GUILE_TM_H
00290 
00291