1 #ifndef S7_H 2 #define S7_H 3 4 #define S7_VERSION "9.9" 5 #define S7_DATE "10-Mar-2021" 6 #define S7_MAJOR_VERSION 9 7 #define S7_MINOR_VERSION 9 8 9 #include <stdint.h> /* for int64_t */ 10 11 typedef int64_t s7_int; 12 typedef double s7_double; 13 14 #ifndef __cplusplus 15 #ifndef _MSC_VER 16 #include <stdbool.h> 17 #else 18 #ifndef true 19 #define bool unsigned char 20 #define true 1 21 #define false 0 22 #endif 23 #endif 24 #endif 25 26 #ifdef __cplusplus 27 extern "C" { 28 #endif 29 30 typedef struct s7_scheme s7_scheme; 31 typedef struct s7_cell *s7_pointer; 32 33 s7_scheme *s7_init(void); 34 35 /* s7_scheme is our interpreter 36 * s7_pointer is a Scheme object of any (Scheme) type 37 * s7_init creates the interpreter. 38 */ 39 void s7_free(s7_scheme *sc); 40 41 typedef s7_pointer (*s7_function)(s7_scheme *sc, s7_pointer args); /* that is, obj = func(s7, args) -- args is a list of arguments */ 42 43 s7_pointer s7_f(s7_scheme *sc); /* #f */ 44 s7_pointer s7_t(s7_scheme *sc); /* #t */ 45 s7_pointer s7_nil(s7_scheme *sc); /* () */ 46 s7_pointer s7_undefined(s7_scheme *sc); /* #<undefined> */ 47 s7_pointer s7_unspecified(s7_scheme *sc); /* #<unspecified> */ 48 bool s7_is_unspecified(s7_scheme *sc, s7_pointer val); /* returns true if val is #<unspecified> */ 49 s7_pointer s7_eof_object(s7_scheme *sc); /* #<eof> */ 50 bool s7_is_null(s7_scheme *sc, s7_pointer p); /* null? */ 51 52 /* these are the Scheme constants; they do not change in value during a run, 53 * so they can be safely assigned to C global variables if desired. 54 */ 55 56 bool s7_is_valid(s7_scheme *sc, s7_pointer arg); /* does 'arg' look like an s7 object? */ 57 bool s7_is_c_pointer(s7_pointer arg); /* (c-pointer? arg) */ 58 bool s7_is_c_pointer_of_type(s7_pointer arg, s7_pointer type); 59 void *s7_c_pointer(s7_pointer p); 60 void *s7_c_pointer_with_type(s7_scheme *sc, s7_pointer p, s7_pointer expected_type, const char *caller, s7_int argnum); 61 s7_pointer s7_c_pointer_type(s7_pointer p); 62 s7_pointer s7_make_c_pointer(s7_scheme *sc, void *ptr); /* these are for passing uninterpreted C pointers through Scheme */ 63 s7_pointer s7_make_c_pointer_with_type(s7_scheme *sc, void *ptr, s7_pointer type, s7_pointer info); 64 65 s7_pointer s7_eval_c_string(s7_scheme *sc, const char *str); /* (eval-string str) */ 66 s7_pointer s7_eval_c_string_with_environment(s7_scheme *sc, const char *str, s7_pointer e); 67 s7_pointer s7_object_to_string(s7_scheme *sc, s7_pointer arg, bool use_write); 68 /* (object->string obj) */ 69 char *s7_object_to_c_string(s7_scheme *sc, s7_pointer obj); /* same as object->string but returns a C char* directly */ 70 /* the returned value should be freed by the caller */ 71 72 s7_pointer s7_load(s7_scheme *sc, const char *file); /* (load file) */ 73 s7_pointer s7_load_with_environment(s7_scheme *sc, const char *filename, s7_pointer e); 74 s7_pointer s7_load_c_string(s7_scheme *sc, const char *content, s7_int bytes); 75 s7_pointer s7_load_c_string_with_environment(s7_scheme *sc, const char *content, s7_int bytes, s7_pointer e); 76 s7_pointer s7_load_path(s7_scheme *sc); /* *load-path* */ 77 s7_pointer s7_add_to_load_path(s7_scheme *sc, const char *dir); /* (set! *load-path* (cons dir *load-path*)) */ 78 s7_pointer s7_autoload(s7_scheme *sc, s7_pointer symbol, s7_pointer file_or_function); /* (autoload symbol file-or-function) */ 79 void s7_autoload_set_names(s7_scheme *sc, const char **names, s7_int size); 80 81 /* the load path is a list of directories to search if load can't find the file passed as its argument. 82 * 83 * s7_load and s7_load_with_environment can load shared object files as well as scheme code. 84 * The scheme (load "somelib.so" (inlet 'init_func 'somelib_init)) is equivalent to 85 * s7_load_with_environment(s7, "somelib.so", s7_inlet(s7, s7_list(s7, 2, s7_make_symbol(s7, "init_func"), s7_make_symbol(s7, "somelib_init")))) 86 * s7_load_with_environment returns NULL if it can't load the file. 87 */ 88 void s7_quit(s7_scheme *sc); 89 /* this tries to break out of the current evaluation, leaving everything else intact */ 90 91 void (*s7_begin_hook(s7_scheme *sc))(s7_scheme *sc, bool *val); 92 void s7_set_begin_hook(s7_scheme *sc, void (*hook)(s7_scheme *sc, bool *val)); 93 /* call "hook" at the start of any block; use NULL to cancel. 94 * s7_begin_hook returns the current begin_hook function or NULL. 95 */ 96 97 s7_pointer s7_eval(s7_scheme *sc, s7_pointer code, s7_pointer e); /* (eval code e) -- e is the optional environment */ 98 void s7_provide(s7_scheme *sc, const char *feature); /* add feature (as a symbol) to the *features* list */ 99 bool s7_is_provided(s7_scheme *sc, const char *feature); /* (provided? feature) */ 100 void s7_repl(s7_scheme *sc); 101 102 s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info); 103 s7_pointer s7_wrong_type_arg_error(s7_scheme *sc, const char *caller, s7_int arg_n, s7_pointer arg, const char *descr); 104 /* set arg_n to 0 to indicate that caller takes only one argument (so the argument number need not be reported */ 105 s7_pointer s7_out_of_range_error(s7_scheme *sc, const char *caller, s7_int arg_n, s7_pointer arg, const char *descr); 106 s7_pointer s7_wrong_number_of_args_error(s7_scheme *sc, const char *caller, s7_pointer args); 107 108 /* these are equivalent to (error ...) in Scheme 109 * the first argument to s7_error is a symbol that can be caught (via (catch tag ...)) 110 * the rest of the arguments are passed to the error handler (if in catch) 111 * or printed out (in the default case). If the first element of the list 112 * of args ("info") is a string, the default error handler treats it as 113 * a format control string, and passes it to format with the rest of the 114 * info list as the format function arguments. 115 * 116 * s7_wrong_type_arg_error is equivalent to s7_error with a type of 'wrong-type-arg 117 * and similarly s7_out_of_range_error with type 'out-of-range. 118 * 119 * catch in Scheme is taken from Guile: 120 * 121 * (catch tag thunk handler) 122 * 123 * evaluates 'thunk'. If an error occurs, and the type matches 'tag' (or if 'tag' is #t), 124 * the handler is called, passing it the arguments (including the type) passed to the 125 * error function. If no handler is found, the default error handler is called, 126 * normally printing the error arguments to current-error-port. 127 */ 128 129 s7_pointer s7_stacktrace(s7_scheme *sc); 130 s7_pointer s7_history(s7_scheme *sc); /* the current (circular backwards) history buffer */ 131 s7_pointer s7_add_to_history(s7_scheme *sc, s7_pointer entry); /* add entry to the history buffer */ 132 bool s7_history_enabled(s7_scheme *sc); 133 bool s7_set_history_enabled(s7_scheme *sc, bool enabled); 134 135 s7_pointer s7_gc_on(s7_scheme *sc, bool on); /* (gc on) */ 136 137 s7_int s7_gc_protect(s7_scheme *sc, s7_pointer x); 138 void s7_gc_unprotect_at(s7_scheme *sc, s7_int loc); 139 s7_pointer s7_gc_protected_at(s7_scheme *sc, s7_int loc); 140 s7_pointer s7_gc_protect_via_stack(s7_scheme *sc, s7_pointer x); 141 s7_pointer s7_gc_unprotect_via_stack(s7_scheme *sc, s7_pointer x); 142 s7_pointer s7_gc_protect_via_location(s7_scheme *sc, s7_pointer x, s7_int loc); 143 s7_pointer s7_gc_unprotect_via_location(s7_scheme *sc, s7_int loc); 144 145 /* any s7_pointer object held in C (as a local variable for example) needs to be 146 * protected from garbage collection if there is any chance the GC may run without 147 * an existing Scheme-level reference to that object. s7_gc_protect places the 148 * object in a vector that the GC always checks, returning the object's location 149 * in that table. s7_gc_unprotect_at unprotects the object (removes it from the 150 * vector) using the location passed to it. s7_gc_protected_at returns the object 151 * at the given location. 152 * 153 * You can turn the GC on and off via s7_gc_on. 154 * 155 * There is a built-in lag between the creation of a new object and its first possible GC 156 * (the lag time is set indirectly by GC_TEMPS_SIZE in s7.c), so you don't need to worry about 157 * very short term temps such as the arguments to s7_cons in: 158 * 159 * s7_cons(s7, s7_make_real(s7, 3.14), 160 * s7_cons(s7, s7_make_integer(s7, 123), s7_nil(s7))); 161 */ 162 163 bool s7_is_eq(s7_pointer a, s7_pointer b); /* (eq? a b) */ 164 bool s7_is_eqv(s7_scheme *sc, s7_pointer a, s7_pointer b); /* (eqv? a b) */ 165 bool s7_is_equal(s7_scheme *sc, s7_pointer a, s7_pointer b); /* (equal? a b) */ 166 bool s7_is_equivalent(s7_scheme *sc, s7_pointer x, s7_pointer y); /* (equivalent? x y) */ 167 168 bool s7_is_boolean(s7_pointer x); /* (boolean? x) */ 169 bool s7_boolean(s7_scheme *sc, s7_pointer x); /* Scheme boolean -> C bool */ 170 s7_pointer s7_make_boolean(s7_scheme *sc, bool x); /* C bool -> Scheme boolean */ 171 172 /* for each Scheme type (boolean, integer, string, etc), there are three 173 * functions: s7_<type>(...), s7_make_<type>(...), and s7_is_<type>(...): 174 * 175 * s7_boolean(s7, obj) returns the C bool corresponding to the value of 'obj' (#f -> false) 176 * s7_make_boolean(s7, false|true) returns the s7 boolean corresponding to the C bool argument (false -> #f) 177 * s7_is_boolean(s7, obj) returns true if 'obj' has a boolean value (#f or #t). 178 */ 179 180 181 bool s7_is_pair(s7_pointer p); /* (pair? p) */ 182 s7_pointer s7_cons(s7_scheme *sc, s7_pointer a, s7_pointer b); /* (cons a b) */ 183 184 s7_pointer s7_car(s7_pointer p); /* (car p) */ 185 s7_pointer s7_cdr(s7_pointer p); /* (cdr p) */ 186 187 s7_pointer s7_set_car(s7_pointer p, s7_pointer q); /* (set-car! p q) */ 188 s7_pointer s7_set_cdr(s7_pointer p, s7_pointer q); /* (set-cdr! p q) */ 189 190 s7_pointer s7_cadr(s7_pointer p); /* (cadr p) */ 191 s7_pointer s7_cddr(s7_pointer p); /* (cddr p) */ 192 s7_pointer s7_cdar(s7_pointer p); /* (cdar p) */ 193 s7_pointer s7_caar(s7_pointer p); /* (caar p) */ 194 195 s7_pointer s7_caadr(s7_pointer p); /* etc */ 196 s7_pointer s7_caddr(s7_pointer p); 197 s7_pointer s7_cadar(s7_pointer p); 198 s7_pointer s7_caaar(s7_pointer p); 199 s7_pointer s7_cdadr(s7_pointer p); 200 s7_pointer s7_cdddr(s7_pointer p); 201 s7_pointer s7_cddar(s7_pointer p); 202 s7_pointer s7_cdaar(s7_pointer p); 203 204 s7_pointer s7_caaadr(s7_pointer p); 205 s7_pointer s7_caaddr(s7_pointer p); 206 s7_pointer s7_caadar(s7_pointer p); 207 s7_pointer s7_caaaar(s7_pointer p); 208 s7_pointer s7_cadadr(s7_pointer p); 209 s7_pointer s7_cadddr(s7_pointer p); 210 s7_pointer s7_caddar(s7_pointer p); 211 s7_pointer s7_cadaar(s7_pointer p); 212 s7_pointer s7_cdaadr(s7_pointer p); 213 s7_pointer s7_cdaddr(s7_pointer p); 214 s7_pointer s7_cdadar(s7_pointer p); 215 s7_pointer s7_cdaaar(s7_pointer p); 216 s7_pointer s7_cddadr(s7_pointer p); 217 s7_pointer s7_cddddr(s7_pointer p); 218 s7_pointer s7_cdddar(s7_pointer p); 219 s7_pointer s7_cddaar(s7_pointer p); 220 221 bool s7_is_list(s7_scheme *sc, s7_pointer p); /* (list? p) -> (or (pair? p) (null? p)) */ 222 bool s7_is_proper_list(s7_scheme *sc, s7_pointer p); /* (proper-list? p) */ 223 s7_int s7_list_length(s7_scheme *sc, s7_pointer a); /* (length a) */ 224 s7_pointer s7_make_list(s7_scheme *sc, s7_int len, s7_pointer init); /* (make-list len init) */ 225 s7_pointer s7_list(s7_scheme *sc, s7_int num_values, ...); /* (list ...) */ 226 s7_pointer s7_list_nl(s7_scheme *sc, s7_int num_values, ...); /* (list ...) arglist should be NULL terminated (more error checks than s7_list) */ 227 s7_pointer s7_reverse(s7_scheme *sc, s7_pointer a); /* (reverse a) */ 228 s7_pointer s7_append(s7_scheme *sc, s7_pointer a, s7_pointer b); /* (append a b) */ 229 s7_pointer s7_list_ref(s7_scheme *sc, s7_pointer lst, s7_int num); /* (list-ref lst num) */ 230 s7_pointer s7_list_set(s7_scheme *sc, s7_pointer lst, s7_int num, s7_pointer val); /* (list-set! lst num val) */ 231 s7_pointer s7_assoc(s7_scheme *sc, s7_pointer obj, s7_pointer lst); /* (assoc obj lst) */ 232 s7_pointer s7_assq(s7_scheme *sc, s7_pointer obj, s7_pointer x); /* (assq obj lst) */ 233 s7_pointer s7_member(s7_scheme *sc, s7_pointer obj, s7_pointer lst); /* (member obj lst) */ 234 s7_pointer s7_memq(s7_scheme *sc, s7_pointer obj, s7_pointer x); /* (memq obj lst) */ 235 bool s7_tree_memq(s7_scheme *sc, s7_pointer sym, s7_pointer tree); /* (tree-memq sym tree) */ 236 237 238 bool s7_is_string(s7_pointer p); /* (string? p) */ 239 const char *s7_string(s7_pointer p); /* Scheme string -> C string (do not free the string) */ 240 s7_pointer s7_make_string(s7_scheme *sc, const char *str); /* C string -> Scheme string (str is copied) */ 241 s7_pointer s7_make_string_with_length(s7_scheme *sc, const char *str, s7_int len); /* same as s7_make_string, but provides strlen */ 242 s7_pointer s7_make_string_wrapper(s7_scheme *sc, const char *str); 243 s7_pointer s7_make_permanent_string(s7_scheme *sc, const char *str); /* make a string that will never be GC'd */ 244 s7_int s7_string_length(s7_pointer str); /* (string-length str) */ 245 246 247 bool s7_is_character(s7_pointer p); /* (character? p) */ 248 uint8_t s7_character(s7_pointer p); /* Scheme character -> unsigned C char */ 249 s7_pointer s7_make_character(s7_scheme *sc, uint8_t c); /* unsigned C char -> Scheme character */ 250 251 252 bool s7_is_number(s7_pointer p); /* (number? p) */ 253 bool s7_is_integer(s7_pointer p); /* (integer? p) */ 254 s7_int s7_integer(s7_pointer p); /* Scheme integer -> C integer (s7_int) */ 255 s7_pointer s7_make_integer(s7_scheme *sc, s7_int num); /* C s7_int -> Scheme integer */ 256 257 bool s7_is_real(s7_pointer p); /* (real? p) */ 258 s7_double s7_real(s7_pointer p); /* Scheme real -> C double */ 259 s7_pointer s7_make_real(s7_scheme *sc, s7_double num); /* C double -> Scheme real */ 260 s7_pointer s7_make_mutable_real(s7_scheme *sc, s7_double n); 261 s7_double s7_number_to_real(s7_scheme *sc, s7_pointer x); /* x can be any kind of number */ 262 s7_double s7_number_to_real_with_caller(s7_scheme *sc, s7_pointer x, const char *caller); 263 s7_int s7_number_to_integer(s7_scheme *sc, s7_pointer x); 264 s7_int s7_number_to_integer_with_caller(s7_scheme *sc, s7_pointer x, const char *caller); 265 266 bool s7_is_rational(s7_pointer arg); /* (rational? arg) -- integer or ratio */ 267 bool s7_is_ratio(s7_pointer arg); /* true if arg is a ratio, not an integer */ 268 s7_pointer s7_make_ratio(s7_scheme *sc, s7_int a, s7_int b); /* returns the Scheme object a/b */ 269 s7_pointer s7_rationalize(s7_scheme *sc, s7_double x, s7_double error); /* (rationalize x error) */ 270 s7_int s7_numerator(s7_pointer x); /* (numerator x) */ 271 s7_int s7_denominator(s7_pointer x); /* (denominator x) */ 272 s7_double s7_random(s7_scheme *sc, s7_pointer state); /* (random x) */ 273 s7_pointer s7_random_state(s7_scheme *sc, s7_pointer seed); /* (random-state seed) */ 274 s7_pointer s7_random_state_to_list(s7_scheme *sc, s7_pointer args); /* (random-state->list r) */ 275 void s7_set_default_random_state(s7_scheme *sc, s7_int seed, s7_int carry); 276 277 bool s7_is_complex(s7_pointer arg); /* (complex? arg) */ 278 s7_pointer s7_make_complex(s7_scheme *sc, s7_double a, s7_double b); /* returns the Scheme object a+bi */ 279 s7_double s7_real_part(s7_pointer z); /* (real-part z) */ 280 s7_double s7_imag_part(s7_pointer z); /* (imag-part z) */ 281 char *s7_number_to_string(s7_scheme *sc, s7_pointer obj, s7_int radix); /* (number->string obj radix) */ 282 283 bool s7_is_vector(s7_pointer p); /* (vector? p) */ 284 s7_int s7_vector_length(s7_pointer vec); /* (vector-length vec) */ 285 s7_int s7_vector_rank(s7_pointer vect); /* number of dimensions in vect */ 286 s7_int s7_vector_dimension(s7_pointer vec, s7_int dim); 287 s7_pointer *s7_vector_elements(s7_pointer vec); /* a pointer to the array of s7_pointers */ 288 s7_int *s7_int_vector_elements(s7_pointer vec); 289 s7_double *s7_float_vector_elements(s7_pointer vec); 290 bool s7_is_float_vector(s7_pointer p); /* (float-vector? p) */ 291 bool s7_is_int_vector(s7_pointer p); /* (int-vector? p) */ 292 293 s7_pointer s7_vector_ref(s7_scheme *sc, s7_pointer vec, s7_int index); /* (vector-ref vec index) */ 294 s7_pointer s7_vector_set(s7_scheme *sc, s7_pointer vec, s7_int index, s7_pointer a); /* (vector-set! vec index a) */ 295 s7_pointer s7_vector_ref_n(s7_scheme *sc, s7_pointer vector, s7_int indices, ...); /* multidimensional vector-ref */ 296 s7_pointer s7_vector_set_n(s7_scheme *sc, s7_pointer vector, s7_pointer value, s7_int indices, ...); /* multidimensional vector-set! */ 297 s7_int s7_vector_dimensions(s7_pointer vec, s7_int *dims, s7_int dims_size); /* vector dimensions */ 298 s7_int s7_vector_offsets(s7_pointer vec, s7_int *offs, s7_int offs_size); 299 300 s7_int s7_int_vector_ref(s7_pointer vec, s7_int index); 301 s7_int s7_int_vector_set(s7_pointer vec, s7_int index, s7_int value); 302 s7_double s7_float_vector_ref(s7_pointer vec, s7_int index); 303 s7_double s7_float_vector_set(s7_pointer vec, s7_int index, s7_double value); 304 305 s7_pointer s7_make_vector(s7_scheme *sc, s7_int len); /* (make-vector len) */ 306 s7_pointer s7_make_int_vector(s7_scheme *sc, s7_int len, s7_int dims, s7_int *dim_info); 307 s7_pointer s7_make_float_vector(s7_scheme *sc, s7_int len, s7_int dims, s7_int *dim_info); 308 s7_pointer s7_make_float_vector_wrapper(s7_scheme *sc, s7_int len, s7_double *data, s7_int dims, s7_int *dim_info, bool free_data); 309 s7_pointer s7_make_and_fill_vector(s7_scheme *sc, s7_int len, s7_pointer fill); /* (make-vector len fill) */ 310 311 void s7_vector_fill(s7_scheme *sc, s7_pointer vec, s7_pointer obj); /* (vector-fill! vec obj) */ 312 s7_pointer s7_vector_copy(s7_scheme *sc, s7_pointer old_vect); 313 s7_pointer s7_vector_to_list(s7_scheme *sc, s7_pointer vect); /* (vector->list vec) */ 314 /* 315 * (vect i) is the same as (vector-ref vect i) 316 * (set! (vect i) x) is the same as (vector-set! vect i x) 317 * (vect i j k) accesses the 3-dimensional vect 318 * (set! (vect i j k) x) sets that element (vector-ref and vector-set! can also be used) 319 * (make-vector (list 2 3 4)) returns a 3-dimensional vector with the given dimension sizes 320 * (make-vector '(2 3) 1.0) returns a 2-dim vector with all elements set to 1.0 321 */ 322 323 bool s7_is_hash_table(s7_pointer p); /* (hash-table? p) */ 324 s7_pointer s7_make_hash_table(s7_scheme *sc, s7_int size); /* (make-hash-table size) */ 325 s7_pointer s7_hash_table_ref(s7_scheme *sc, s7_pointer table, s7_pointer key); 326 /* (hash-table-ref table key) */ 327 s7_pointer s7_hash_table_set(s7_scheme *sc, s7_pointer table, s7_pointer key, s7_pointer value); 328 /* (hash-table-set! table key value) */ 329 s7_int s7_hash_code(s7_scheme *sc, s7_pointer obj, s7_pointer eqfunc); /* (hash-code obj [eqfunc]) */ 330 331 s7_pointer s7_hook_functions(s7_scheme *sc, s7_pointer hook); /* (hook-functions hook) */ 332 s7_pointer s7_hook_set_functions(s7_scheme *sc, s7_pointer hook, s7_pointer functions); /* (set! (hook-functions hook) ...) */ 333 334 335 bool s7_is_input_port(s7_scheme *sc, s7_pointer p); /* (input-port? p) */ 336 bool s7_is_output_port(s7_scheme *sc, s7_pointer p); /* (output-port? p) */ 337 const char *s7_port_filename(s7_scheme *sc, s7_pointer x); /* (port-filename p) */ 338 s7_int s7_port_line_number(s7_scheme *sc, s7_pointer p); /* (port-line-number p) */ 339 340 s7_pointer s7_current_input_port(s7_scheme *sc); /* (current-input-port) */ 341 s7_pointer s7_set_current_input_port(s7_scheme *sc, s7_pointer p); /* (set-current-input-port) */ 342 s7_pointer s7_current_output_port(s7_scheme *sc); /* (current-output-port) */ 343 s7_pointer s7_set_current_output_port(s7_scheme *sc, s7_pointer p); /* (set-current-output-port) */ 344 s7_pointer s7_current_error_port(s7_scheme *sc); /* (current-error-port) */ 345 s7_pointer s7_set_current_error_port(s7_scheme *sc, s7_pointer port); /* (set-current-error-port port) */ 346 void s7_close_input_port(s7_scheme *sc, s7_pointer p); /* (close-input-port p) */ 347 void s7_close_output_port(s7_scheme *sc, s7_pointer p); /* (close-output-port p) */ 348 s7_pointer s7_open_input_file(s7_scheme *sc, const char *name, const char *mode); 349 /* (open-input-file name mode) */ 350 s7_pointer s7_open_output_file(s7_scheme *sc, const char *name, const char *mode); 351 /* (open-output-file name mode) */ 352 /* mode here is an optional C style flag, "a" for "alter", etc ("r" is the input default, "w" is the output default) */ 353 s7_pointer s7_open_input_string(s7_scheme *sc, const char *input_string); 354 /* (open-input-string str) */ 355 s7_pointer s7_open_output_string(s7_scheme *sc); /* (open-output-string) */ 356 const char *s7_get_output_string(s7_scheme *sc, s7_pointer out_port); /* (get-output-string port) -- current contents of output string */ 357 /* don't free the string */ 358 void s7_flush_output_port(s7_scheme *sc, s7_pointer p); /* (flush-output-port port) */ 359 360 typedef enum {S7_READ, S7_READ_CHAR, S7_READ_LINE, S7_PEEK_CHAR, S7_IS_CHAR_READY, S7_NUM_READ_CHOICES} s7_read_t; 361 s7_pointer s7_open_output_function(s7_scheme *sc, void (*function)(s7_scheme *sc, uint8_t c, s7_pointer port)); 362 s7_pointer s7_open_input_function(s7_scheme *sc, s7_pointer (*function)(s7_scheme *sc, s7_read_t read_choice, s7_pointer port)); 363 364 s7_pointer s7_read_char(s7_scheme *sc, s7_pointer port); /* (read-char port) */ 365 s7_pointer s7_peek_char(s7_scheme *sc, s7_pointer port); /* (peek-char port) */ 366 s7_pointer s7_read(s7_scheme *sc, s7_pointer port); /* (read port) */ 367 void s7_newline(s7_scheme *sc, s7_pointer port); /* (newline port) */ 368 s7_pointer s7_write_char(s7_scheme *sc, s7_pointer c, s7_pointer port); /* (write-char c port) */ 369 s7_pointer s7_write(s7_scheme *sc, s7_pointer obj, s7_pointer port); /* (write obj port) */ 370 s7_pointer s7_display(s7_scheme *sc, s7_pointer obj, s7_pointer port); /* (display obj port) */ 371 const char *s7_format(s7_scheme *sc, s7_pointer args); /* (format ... */ 372 373 374 bool s7_is_syntax(s7_pointer p); /* (syntax? p) */ 375 bool s7_is_symbol(s7_pointer p); /* (symbol? p) */ 376 const char *s7_symbol_name(s7_pointer p); /* (symbol->string p) -- don't free the string */ 377 s7_pointer s7_make_symbol(s7_scheme *sc, const char *name); /* (string->symbol name) */ 378 s7_pointer s7_gensym(s7_scheme *sc, const char *prefix); /* (gensym prefix) */ 379 380 bool s7_is_keyword(s7_pointer obj); /* (keyword? obj) */ 381 s7_pointer s7_make_keyword(s7_scheme *sc, const char *key); /* (string->keyword key) */ 382 s7_pointer s7_keyword_to_symbol(s7_scheme *sc, s7_pointer key); /* (keyword->symbol key) */ 383 384 s7_pointer s7_rootlet(s7_scheme *sc); /* (rootlet) */ 385 s7_pointer s7_shadow_rootlet(s7_scheme *sc); 386 s7_pointer s7_set_shadow_rootlet(s7_scheme *sc, s7_pointer let); 387 s7_pointer s7_curlet(s7_scheme *sc); /* (curlet) */ 388 s7_pointer s7_set_curlet(s7_scheme *sc, s7_pointer e); /* returns previous curlet */ 389 s7_pointer s7_outlet(s7_scheme *sc, s7_pointer e); /* (outlet e) */ 390 s7_pointer s7_sublet(s7_scheme *sc, s7_pointer env, s7_pointer bindings); /* (sublet e ...) */ 391 s7_pointer s7_inlet(s7_scheme *sc, s7_pointer bindings); /* (inlet ...) */ 392 s7_pointer s7_varlet(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value); /* (varlet env symbol value) */ 393 s7_pointer s7_let_to_list(s7_scheme *sc, s7_pointer env); /* (let->list env) */ 394 bool s7_is_let(s7_pointer e); /* )let? e) */ 395 s7_pointer s7_let_ref(s7_scheme *sc, s7_pointer env, s7_pointer sym); /* (let-ref e sym) */ 396 s7_pointer s7_let_set(s7_scheme *sc, s7_pointer env, s7_pointer sym, s7_pointer val); /* (let-set! e sym val) */ 397 s7_pointer s7_openlet(s7_scheme *sc, s7_pointer e); /* (openlet e) */ 398 bool s7_is_openlet(s7_pointer e); /* (openlet? e) */ 399 s7_pointer s7_method(s7_scheme *sc, s7_pointer obj, s7_pointer method); 400 401 /* *s7* */ 402 s7_pointer s7_let_field_ref(s7_scheme *sc, s7_pointer sym); /* (*s7* sym) */ 403 s7_pointer s7_let_field_set(s7_scheme *sc, s7_pointer sym, s7_pointer new_value); /* (set! (*s7* sym) new_value) */ 404 405 406 s7_pointer s7_name_to_value(s7_scheme *sc, const char *name); /* name's value in the current environment (after turning name into a symbol) */ 407 s7_pointer s7_symbol_table_find_name(s7_scheme *sc, const char *name); 408 s7_pointer s7_symbol_value(s7_scheme *sc, s7_pointer sym); 409 s7_pointer s7_symbol_set_value(s7_scheme *sc, s7_pointer sym, s7_pointer val); 410 s7_pointer s7_symbol_local_value(s7_scheme *sc, s7_pointer sym, s7_pointer local_env); 411 bool s7_for_each_symbol_name(s7_scheme *sc, bool (*symbol_func)(const char *symbol_name, void *data), void *data); 412 bool s7_for_each_symbol(s7_scheme *sc, bool (*symbol_func)(const char *symbol_name, void *data), void *data); 413 414 /* these access the current environment and symbol table, providing 415 * a symbol's current binding (s7_name_to_value takes the symbol name as a char*, 416 * s7_symbol_value takes the symbol itself, s7_symbol_set_value changes the 417 * current binding, and s7_symbol_local_value uses the environment passed 418 * as its third argument). 419 * 420 * To iterate over the complete symbol table, use s7_for_each_symbol_name, 421 * and s7_for_each_symbol. Both call 'symbol_func' on each symbol, passing it 422 * the symbol or symbol name, and the uninterpreted 'data' pointer. 423 * the current binding. The for-each loop stops if the symbol_func returns true, 424 * or at the end of the table. 425 */ 426 427 s7_pointer s7_dynamic_wind(s7_scheme *sc, s7_pointer init, s7_pointer body, s7_pointer finish); 428 429 bool s7_is_immutable(s7_pointer p); 430 s7_pointer s7_immutable(s7_pointer p); 431 432 void s7_define(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value); 433 bool s7_is_defined(s7_scheme *sc, const char *name); 434 s7_pointer s7_define_variable(s7_scheme *sc, const char *name, s7_pointer value); 435 s7_pointer s7_define_variable_with_documentation(s7_scheme *sc, const char *name, s7_pointer value, const char *help); 436 s7_pointer s7_define_constant(s7_scheme *sc, const char *name, s7_pointer value); 437 s7_pointer s7_define_constant_with_documentation(s7_scheme *sc, const char *name, s7_pointer value, const char *help); 438 s7_pointer s7_define_constant_with_environment(s7_scheme *sc, s7_pointer envir, const char *name, s7_pointer value); 439 /* These functions add a symbol and its binding to either the top-level environment 440 * or the 'env' passed as the second argument to s7_define. 441 * 442 * s7_define_variable(sc, "*features*", s7_nil(sc)); 443 * 444 * in s7.c is equivalent to the top level form 445 * 446 * (define *features* ()) 447 * 448 * s7_define_variable is simply s7_define with string->symbol and the global environment. 449 * s7_define_constant is s7_define but makes its "definee" immutable. 450 * s7_define is equivalent to define in Scheme. 451 */ 452 453 bool s7_is_function(s7_pointer p); 454 bool s7_is_procedure(s7_pointer x); /* (procedure? x) */ 455 bool s7_is_macro(s7_scheme *sc, s7_pointer x); /* (macro? x) */ 456 s7_pointer s7_closure_body(s7_scheme *sc, s7_pointer p); 457 s7_pointer s7_closure_let(s7_scheme *sc, s7_pointer p); 458 s7_pointer s7_closure_args(s7_scheme *sc, s7_pointer p); 459 s7_pointer s7_funclet(s7_scheme *sc, s7_pointer p); /* (funclet x) */ 460 bool s7_is_aritable(s7_scheme *sc, s7_pointer x, s7_int args); /* (aritable? x args) */ 461 s7_pointer s7_arity(s7_scheme *sc, s7_pointer x); /* (arity x) */ 462 const char *s7_help(s7_scheme *sc, s7_pointer obj); /* (help obj) */ 463 s7_pointer s7_make_continuation(s7_scheme *sc); /* call/cc... (see example below) */ 464 465 const char *s7_documentation(s7_scheme *sc, s7_pointer p); /* (documentation x) if any (don't free the string) */ 466 const char *s7_set_documentation(s7_scheme *sc, s7_pointer p, const char *new_doc); 467 s7_pointer s7_setter(s7_scheme *sc, s7_pointer obj); /* (setter obj) */ 468 s7_pointer s7_set_setter(s7_scheme *sc, s7_pointer p, s7_pointer setter); /* (set! (setter p) setter) */ 469 s7_pointer s7_signature(s7_scheme *sc, s7_pointer func); /* (signature obj) */ 470 s7_pointer s7_make_signature(s7_scheme *sc, s7_int len, ...); /* procedure-signature data */ 471 s7_pointer s7_make_circular_signature(s7_scheme *sc, s7_int cycle_point, s7_int len, ...); 472 473 /* possibly unsafe functions: */ 474 s7_pointer s7_make_function(s7_scheme *sc, const char *name, s7_function fnc, s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc); 475 476 /* safe functions: */ 477 s7_pointer s7_make_safe_function(s7_scheme *sc, const char *name, s7_function fnc, s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc); 478 s7_pointer s7_make_typed_function(s7_scheme *sc, const char *name, s7_function f, 479 s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc, s7_pointer signature); 480 481 /* arglist or body possibly unsafe: */ 482 s7_pointer s7_define_function(s7_scheme *sc, const char *name, s7_function fnc, s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc); 483 484 /* arglist and body safe: */ 485 s7_pointer s7_define_safe_function(s7_scheme *sc, const char *name, s7_function fnc, s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc); 486 s7_pointer s7_define_typed_function(s7_scheme *sc, const char *name, s7_function fnc, 487 s7_int required_args, s7_int optional_args, bool rest_arg, 488 const char *doc, s7_pointer signature); 489 490 /* arglist unsafe or body unsafe: */ 491 s7_pointer s7_define_unsafe_typed_function(s7_scheme *sc, const char *name, s7_function fnc, 492 s7_int required_args, s7_int optional_args, bool rest_arg, 493 const char *doc, s7_pointer signature); 494 495 /* arglist safe, body possibly unsafe: */ 496 s7_pointer s7_define_semisafe_typed_function(s7_scheme *sc, const char *name, s7_function fnc, 497 s7_int required_args, s7_int optional_args, bool rest_arg, 498 const char *doc, s7_pointer signature); 499 500 s7_pointer s7_make_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc); 501 s7_pointer s7_make_safe_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc); 502 void s7_define_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc); 503 void s7_define_safe_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc); 504 void s7_define_typed_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc, s7_pointer signature); 505 s7_pointer s7_define_macro(s7_scheme *sc, const char *name, s7_function fnc, s7_int required_args, s7_int optional_args, bool rest_arg, const char *doc); 506 507 /* s7_make_function creates a Scheme function object from the s7_function 'fnc'. 508 * Its name (for s7_describe_object) is 'name', it requires 'required_args' arguments, 509 * can accept 'optional_args' other arguments, and if 'rest_arg' is true, it accepts 510 * a "rest" argument (a list of all the trailing arguments). The function's documentation 511 * is 'doc'. 512 * 513 * s7_define_function is the same as s7_make_function, but it also adds 'name' (as a symbol) to the 514 * global (top-level) environment, with the function as its value. For example, the Scheme 515 * function 'car' is essentially: 516 * 517 * s7_pointer g_car(s7_scheme *sc, s7_pointer args) {return(s7_car(s7_car(args)));} 518 * 519 * then bound to the name "car": 520 * 521 * s7_define_function(sc, "car", g_car, 1, 0, false, "(car obj)"); 522 * one required arg, no optional arg, no "rest" arg 523 * 524 * s7_is_function returns true if its argument is a function defined in this manner. 525 * s7_apply_function applies the function (the result of s7_make_function) to the arguments. 526 * 527 * s7_define_macro defines a Scheme macro; its arguments are not evaluated (unlike a function), 528 * but its returned value (assumed to be some sort of Scheme expression) is evaluated. 529 * 530 * Use the "unsafe" definer if the function might call the evaluator itself in some way (s7_apply_function for example), 531 * or messes with s7's stack. 532 */ 533 534 /* In s7, (define* (name . args) body) or (define name (lambda* args body)) 535 * define a function that takes optional (keyword) named arguments. 536 * The "args" is a list that can contain either names (normal arguments), 537 * or lists of the form (name default-value), in any order. When called, 538 * the names are bound to their default values (or #f), then the function's 539 * current arglist is scanned. Any name that occurs as a keyword (":name") 540 * precedes that argument's new value. Otherwise, as values occur, they 541 * are plugged into the environment based on their position in the arglist 542 * (as normal for a function). So, 543 * 544 * (define* (hi a (b 32) (c "hi")) (list a b c)) 545 * (hi 1) -> '(1 32 "hi") 546 * (hi :b 2 :a 3) -> '(3 2 "hi") 547 * (hi 3 2 1) -> '(3 2 1) 548 * 549 * :rest causes its argument to be bound to the rest of the arguments at that point. 550 * 551 * The C connection to this takes the function name, the C function to call, the argument 552 * list as written in Scheme, and the documentation string. s7 makes sure the arguments 553 * are ordered correctly and have the specified defaults before calling the C function. 554 * s7_define_function_star(sc, "a-func", a_func, "arg1 (arg2 32)", "an example of C define*"); 555 * Now (a-func :arg1 2) calls the C function a_func(2, 32). See the example program in s7.html. 556 * 557 * In s7 Scheme, define* can be used just for its optional arguments feature, but that is 558 * included in s7_define_function. s7_define_function_star implements keyword arguments 559 * for C-level functions (as well as optional/rest arguments). 560 */ 561 562 s7_pointer s7_apply_function(s7_scheme *sc, s7_pointer fnc, s7_pointer args); 563 s7_pointer s7_apply_function_star(s7_scheme *sc, s7_pointer fnc, s7_pointer args); 564 565 s7_pointer s7_call(s7_scheme *sc, s7_pointer func, s7_pointer args); 566 s7_pointer s7_call_with_location(s7_scheme *sc, s7_pointer func, s7_pointer args, const char *caller, const char *file, s7_int line); 567 s7_pointer s7_call_with_catch(s7_scheme *sc, s7_pointer tag, s7_pointer body, s7_pointer error_handler); 568 569 /* s7_call takes a Scheme function (e.g. g_car above), and applies it to 'args' (a list of arguments) returning the result. 570 * s7_integer(s7_call(s7, g_car, s7_cons(s7, s7_make_integer(s7, 123), s7_nil(s7)))); 571 * returns 123. 572 * 573 * s7_call_with_location passes some information to the error handler. 574 * s7_call makes sure some sort of catch exists if an error occurs during the call, but 575 * s7_apply_function does not -- it assumes the catch has been set up already. 576 * s7_call_with_catch wraps an explicit catch around a function call ("body" above); 577 * s7_call_with_catch(sc, tag, body, err) is equivalent to (catch tag body err). 578 */ 579 580 bool s7_is_dilambda(s7_pointer obj); 581 s7_pointer s7_dilambda(s7_scheme *sc, 582 const char *name, 583 s7_pointer (*getter)(s7_scheme *sc, s7_pointer args), 584 s7_int get_req_args, s7_int get_opt_args, 585 s7_pointer (*setter)(s7_scheme *sc, s7_pointer args), 586 s7_int set_req_args, s7_int set_opt_args, 587 const char *documentation); 588 s7_pointer s7_typed_dilambda(s7_scheme *sc, 589 const char *name, 590 s7_pointer (*getter)(s7_scheme *sc, s7_pointer args), 591 s7_int get_req_args, s7_int get_opt_args, 592 s7_pointer (*setter)(s7_scheme *sc, s7_pointer args), 593 s7_int set_req_args, s7_int set_opt_args, 594 const char *documentation, 595 s7_pointer get_sig, s7_pointer set_sig); 596 s7_pointer s7_dilambda_with_environment(s7_scheme *sc, s7_pointer envir, 597 const char *name, 598 s7_pointer (*getter)(s7_scheme *sc, s7_pointer args), 599 s7_int get_req_args, s7_int get_opt_args, 600 s7_pointer (*setter)(s7_scheme *sc, s7_pointer args), 601 s7_int set_req_args, s7_int set_opt_args, 602 const char *documentation); 603 604 s7_pointer s7_values(s7_scheme *sc, s7_pointer args); /* (values ...) */ 605 606 607 s7_pointer s7_make_iterator(s7_scheme *sc, s7_pointer e); /* (make-iterator e) */ 608 bool s7_is_iterator(s7_pointer obj); /* (iterator? obj) */ 609 bool s7_iterator_is_at_end(s7_scheme *sc, s7_pointer obj); /* (iterator-at-end? obj) */ 610 s7_pointer s7_iterate(s7_scheme *sc, s7_pointer iter); /* (iterate iter) */ 611 612 s7_pointer s7_copy(s7_scheme *sc, s7_pointer args); /* (copy ...) */ 613 s7_pointer s7_fill(s7_scheme *sc, s7_pointer args); /* (fill! ...) */ 614 s7_pointer s7_type_of(s7_scheme *sc, s7_pointer arg); /* (type-of arg) */ 615 616 617 618 /* -------------------------------------------------------------------------------- */ 619 /* c types/objects */ 620 621 void s7_mark(s7_pointer p); 622 623 bool s7_is_c_object(s7_pointer p); 624 s7_int s7_c_object_type(s7_pointer obj); 625 void *s7_c_object_value(s7_pointer obj); 626 void *s7_c_object_value_checked(s7_pointer obj, s7_int type); 627 s7_pointer s7_make_c_object(s7_scheme *sc, s7_int type, void *value); 628 s7_pointer s7_make_c_object_with_let(s7_scheme *sc, s7_int type, void *value, s7_pointer let); 629 s7_pointer s7_c_object_let(s7_pointer obj); 630 s7_pointer s7_c_object_set_let(s7_scheme *sc, s7_pointer obj, s7_pointer e); 631 /* the "let" in s7_make_c_object_with_let and s7_c_object_set_let needs to be GC protected by marking it in the c_object's mark function */ 632 633 s7_int s7_make_c_type(s7_scheme *sc, const char *name); /* create a new c_object type */ 634 635 /* old style free/mark/equal */ 636 void s7_c_type_set_free (s7_scheme *sc, s7_int tag, void (*gc_free)(void *value)); 637 void s7_c_type_set_mark (s7_scheme *sc, s7_int tag, void (*mark)(void *value)); 638 void s7_c_type_set_equal (s7_scheme *sc, s7_int tag, bool (*equal)(void *value1, void *value2)); 639 640 /* new style free/mark/equal and equivalent */ 641 void s7_c_type_set_gc_free (s7_scheme *sc, s7_int tag, s7_pointer (*gc_free) (s7_scheme *sc, s7_pointer obj)); /* free c_object function, new style*/ 642 void s7_c_type_set_gc_mark (s7_scheme *sc, s7_int tag, s7_pointer (*mark) (s7_scheme *sc, s7_pointer obj)); /* mark function, new style */ 643 void s7_c_type_set_is_equal (s7_scheme *sc, s7_int tag, s7_pointer (*is_equal) (s7_scheme *sc, s7_pointer args)); 644 void s7_c_type_set_is_equivalent(s7_scheme *sc, s7_int tag, s7_pointer (*is_equivalent)(s7_scheme *sc, s7_pointer args)); 645 646 void s7_c_type_set_ref (s7_scheme *sc, s7_int tag, s7_pointer (*ref) (s7_scheme *sc, s7_pointer args)); 647 void s7_c_type_set_set (s7_scheme *sc, s7_int tag, s7_pointer (*set) (s7_scheme *sc, s7_pointer args)); 648 void s7_c_type_set_length (s7_scheme *sc, s7_int tag, s7_pointer (*length) (s7_scheme *sc, s7_pointer args)); 649 void s7_c_type_set_copy (s7_scheme *sc, s7_int tag, s7_pointer (*copy) (s7_scheme *sc, s7_pointer args)); 650 void s7_c_type_set_fill (s7_scheme *sc, s7_int tag, s7_pointer (*fill) (s7_scheme *sc, s7_pointer args)); 651 void s7_c_type_set_reverse (s7_scheme *sc, s7_int tag, s7_pointer (*reverse) (s7_scheme *sc, s7_pointer args)); 652 void s7_c_type_set_to_list (s7_scheme *sc, s7_int tag, s7_pointer (*to_list) (s7_scheme *sc, s7_pointer args)); 653 void s7_c_type_set_to_string (s7_scheme *sc, s7_int tag, s7_pointer (*to_string) (s7_scheme *sc, s7_pointer args)); 654 void s7_c_type_set_getter (s7_scheme *sc, s7_int tag, s7_pointer getter); 655 void s7_c_type_set_setter (s7_scheme *sc, s7_int tag, s7_pointer setter); 656 /* For the copy function, either the first or second argument can be a c-object of the given type. */ 657 658 /* These functions create a new Scheme object type. There is a simple example in s7.html. 659 * 660 * s7_make_c_type creates a new C-based type for Scheme. It returns an s7_int "tag" used to indentify this type elsewhere. 661 * The functions associated with this type are set via s7_c_type_set*: 662 * 663 * free: the function called when an object of this type is about to be garbage collected 664 * mark: called during the GC mark pass -- you should call s7_mark 665 * on any embedded s7_pointer associated with the object (including its "let") to protect if from the GC. 666 * gc_mark and gc_free are new forms of mark and free, taking the c_object s7_pointer rather than its void* value 667 * equal: compare two objects of this type; (equal? obj1 obj2) -- this is the old form 668 * is_equal: compare objects as in equal? -- this is the new form of equal? 669 * is_equivalent: compare objects as in equivalent? 670 * ref: a function that is called whenever an object of this type 671 * occurs in the function position (at the car of a list; the rest of the list 672 * is passed to the ref function as the arguments: (obj ...)) 673 * set: a function that is called whenever an object of this type occurs as 674 * the target of a generalized set! (set! (obj ...) val) 675 * length: the function called when the object is asked what its length is. 676 * copy: the function called when a copy of the object is needed. 677 * fill: the function called to fill the object with some value. 678 * reverse: similarly... 679 * to_string: object->string for an object of this type 680 * getter/setter: these help the optimizer handle applicable c-objects (see s7test.scm for an example) 681 * 682 * s7_is_c_object returns true if 'p' is a c_object 683 * s7_c_object_type returns the c_object's type (the s7_int passed to s7_make_c_object) 684 * s7_c_object_value returns the value bound to that c_object (the void *value of s7_make_c_object) 685 * s7_make_c_object creates a new Scheme entity of the given type with the given (uninterpreted) value 686 * s7_mark marks any Scheme c_object as in-use (use this in the mark function to mark 687 * any embedded s7_pointer variables). 688 */ 689 690 /* -------------------------------------------------------------------------------- */ 691 /* the new clm optimizer! this time for sure! 692 * d=double, i=integer, v=c_object, p=s7_pointer 693 * first return type, then arg types, d_vd -> returns double takes c_object and double (i.e. a standard clm generator) 694 * 695 * It is possible to tell s7 to call a foreign function directly, without any scheme-related 696 * overhead. The call needs to take the form of one of the s7_*_t functions in s7.h. For example, 697 * one way to call + is to pass it two s7_double arguments and get an s7_double back. This is the 698 * s7_d_dd_t function (the first letter gives the return type, the rest give successive argument types). 699 * We tell s7 about it via s7_set_d_dd_function. Whenever s7's optimizer encounters + with two arguments 700 * that it (the optimizer) knows are s7_doubles, in a context where an s7_double result is expected, 701 * s7 calls the s7_d_dd_t function directly without consing a list of arguments, and without 702 * wrapping up the result as a scheme cell. 703 */ 704 705 s7_function s7_optimize(s7_scheme *sc, s7_pointer expr); 706 707 typedef s7_double (*s7_float_function)(s7_scheme *sc, s7_pointer args); 708 s7_float_function s7_float_optimize(s7_scheme *sc, s7_pointer expr); 709 710 typedef s7_double (*s7_d_t)(void); 711 void s7_set_d_function(s7_scheme *sc, s7_pointer f, s7_d_t df); 712 s7_d_t s7_d_function(s7_pointer f); 713 714 typedef s7_double (*s7_d_d_t)(s7_double x); 715 void s7_set_d_d_function(s7_scheme *sc, s7_pointer f, s7_d_d_t df); 716 s7_d_d_t s7_d_d_function(s7_pointer f); 717 718 typedef s7_double (*s7_d_dd_t)(s7_double x1, s7_double x2); 719 void s7_set_d_dd_function(s7_scheme *sc, s7_pointer f, s7_d_dd_t df); 720 s7_d_dd_t s7_d_dd_function(s7_pointer f); 721 722 typedef s7_double (*s7_d_ddd_t)(s7_double x1, s7_double x2, s7_double x3); 723 void s7_set_d_ddd_function(s7_scheme *sc, s7_pointer f, s7_d_ddd_t df); 724 s7_d_ddd_t s7_d_ddd_function(s7_pointer f); 725 726 typedef s7_double (*s7_d_dddd_t)(s7_double x1, s7_double x2, s7_double x3, s7_double x4); 727 void s7_set_d_dddd_function(s7_scheme *sc, s7_pointer f, s7_d_dddd_t df); 728 s7_d_dddd_t s7_d_dddd_function(s7_pointer f); 729 730 typedef s7_double (*s7_d_v_t)(void *v); 731 void s7_set_d_v_function(s7_scheme *sc, s7_pointer f, s7_d_v_t df); 732 s7_d_v_t s7_d_v_function(s7_pointer f); 733 734 typedef s7_double (*s7_d_vd_t)(void *v, s7_double d); 735 void s7_set_d_vd_function(s7_scheme *sc, s7_pointer f, s7_d_vd_t df); 736 s7_d_vd_t s7_d_vd_function(s7_pointer f); 737 738 typedef s7_double (*s7_d_vdd_t)(void *v, s7_double x1, s7_double x2); 739 void s7_set_d_vdd_function(s7_scheme *sc, s7_pointer f, s7_d_vdd_t df); 740 s7_d_vdd_t s7_d_vdd_function(s7_pointer f); 741 742 typedef s7_double (*s7_d_vid_t)(void *v, s7_int i, s7_double d); 743 void s7_set_d_vid_function(s7_scheme *sc, s7_pointer f, s7_d_vid_t df); 744 s7_d_vid_t s7_d_vid_function(s7_pointer f); 745 746 typedef s7_double (*s7_d_p_t)(s7_pointer p); 747 void s7_set_d_p_function(s7_scheme *sc, s7_pointer f, s7_d_p_t df); 748 s7_d_p_t s7_d_p_function(s7_pointer f); 749 750 typedef s7_double (*s7_d_pd_t)(s7_pointer v, s7_double x); 751 void s7_set_d_pd_function(s7_scheme *sc, s7_pointer f, s7_d_pd_t df); 752 s7_d_pd_t s7_d_pd_function(s7_pointer f); 753 754 typedef s7_double (*s7_d_7pi_t)(s7_scheme *sc, s7_pointer v, s7_int i); 755 void s7_set_d_7pi_function(s7_scheme *sc, s7_pointer f, s7_d_7pi_t df); 756 s7_d_7pi_t s7_d_7pi_function(s7_pointer f); 757 758 typedef s7_double (*s7_d_7pid_t)(s7_scheme *sc, s7_pointer v, s7_int i, s7_double d); 759 void s7_set_d_7pid_function(s7_scheme *sc, s7_pointer f, s7_d_7pid_t df); 760 s7_d_7pid_t s7_d_7pid_function(s7_pointer f); 761 762 typedef s7_double (*s7_d_id_t)(s7_int i, s7_double d); 763 void s7_set_d_id_function(s7_scheme *sc, s7_pointer f, s7_d_id_t df); 764 s7_d_id_t s7_d_id_function(s7_pointer f); 765 766 typedef s7_double (*s7_d_ip_t)(s7_int i, s7_pointer p); 767 void s7_set_d_ip_function(s7_scheme *sc, s7_pointer f, s7_d_ip_t df); 768 s7_d_ip_t s7_d_ip_function(s7_pointer f); 769 770 typedef s7_int (*s7_i_i_t)(s7_int x); 771 void s7_set_i_i_function(s7_scheme *sc, s7_pointer f, s7_i_i_t df); 772 s7_i_i_t s7_i_i_function(s7_pointer f); 773 774 typedef s7_int (*s7_i_7d_t)(s7_scheme *sc, s7_double x); 775 void s7_set_i_7d_function(s7_scheme *sc, s7_pointer f, s7_i_7d_t df); 776 s7_i_7d_t s7_i_7d_function(s7_pointer f); 777 778 typedef s7_int (*s7_i_ii_t)(s7_int i1, s7_int i2); 779 void s7_set_i_ii_function(s7_scheme *sc, s7_pointer f, s7_i_ii_t df); 780 s7_i_ii_t s7_i_ii_function(s7_pointer f); 781 782 typedef s7_int (*s7_i_7p_t)(s7_scheme *sc, s7_pointer p); 783 void s7_set_i_7p_function(s7_scheme *sc, s7_pointer f, s7_i_7p_t df); 784 s7_i_7p_t s7_i_7p_function(s7_pointer f); 785 786 typedef bool (*s7_b_p_t)(s7_pointer p); 787 void s7_set_b_p_function(s7_scheme *sc, s7_pointer f, s7_b_p_t df); 788 s7_b_p_t s7_b_p_function(s7_pointer f); 789 790 typedef s7_pointer (*s7_p_d_t)(s7_scheme *sc, s7_double x); 791 void s7_set_p_d_function(s7_scheme *sc, s7_pointer f, s7_p_d_t df); 792 s7_p_d_t s7_p_d_function(s7_pointer f); 793 794 /* Here is an example of using these functions; more extensive examples are in clm2xen.c in sndlib, and in s7.c. 795 * (This example comes from a HackerNews discussion): 796 * plus.c: 797 * -------- 798 * #include "s7.h" 799 * 800 * s7_pointer g_plusone(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, s7_integer(s7_car(args)) + 1));} 801 * s7_int plusone(s7_int x) {return(x + 1);} 802 * 803 * void plusone_init(s7_scheme *sc) 804 * { 805 * s7_define_safe_function(sc, "plusone", g_plusone, 1, 0, false, ""); 806 * s7_set_i_i_function(sc, s7_name_to_value(sc, "plusone"), plusone); 807 * } 808 * -------- 809 * gcc -c plus.c -fPIC -O2 -lm 810 * gcc plus.o -shared -o plus.so -ldl -lm -Wl,-export-dynamic 811 * repl 812 * <1> (load "plus.so" (inlet 'init_func 'plusone_init)) 813 * -------- 814 */ 815 816 817 /* -------------------------------------------------------------------------------- */ 818 819 /* maybe remove these? */ 820 s7_pointer s7_slot(s7_scheme *sc, s7_pointer symbol); 821 s7_pointer s7_slot_value(s7_pointer slot); 822 s7_pointer s7_slot_set_value(s7_scheme *sc, s7_pointer slot, s7_pointer value); 823 s7_pointer s7_make_slot(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value); 824 void s7_slot_set_real_value(s7_scheme *sc, s7_pointer slot, s7_double value); 825 826 /* -------------------------------------------------------------------------------- */ 827 828 /* these will be deprecated and removed eventually */ 829 s7_pointer s7_apply_1(s7_scheme *sc, s7_pointer args, s7_pointer (*f1)(s7_pointer a1)); 830 s7_pointer s7_apply_2(s7_scheme *sc, s7_pointer args, s7_pointer (*f2)(s7_pointer a1, s7_pointer a2)); 831 s7_pointer s7_apply_3(s7_scheme *sc, s7_pointer args, s7_pointer (*f3)(s7_pointer a1, s7_pointer a2, s7_pointer a3)); 832 s7_pointer s7_apply_4(s7_scheme *sc, s7_pointer args, s7_pointer (*f4)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4)); 833 s7_pointer s7_apply_5(s7_scheme *sc, s7_pointer args, s7_pointer (*f5)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5)); 834 s7_pointer s7_apply_6(s7_scheme *sc, s7_pointer args, 835 s7_pointer (*f6)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, 836 s7_pointer a5, s7_pointer a6)); 837 s7_pointer s7_apply_7(s7_scheme *sc, s7_pointer args, 838 s7_pointer (*f7)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, 839 s7_pointer a5, s7_pointer a6, s7_pointer a7)); 840 s7_pointer s7_apply_8(s7_scheme *sc, s7_pointer args, 841 s7_pointer (*f8)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, 842 s7_pointer a5, s7_pointer a6, s7_pointer a7, s7_pointer a8)); 843 s7_pointer s7_apply_9(s7_scheme *sc, s7_pointer args, 844 s7_pointer (*f9)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, 845 s7_pointer a5, s7_pointer a6, s7_pointer a7, s7_pointer a8, s7_pointer a9)); 846 847 s7_pointer s7_apply_n_1(s7_scheme *sc, s7_pointer args, s7_pointer (*f1)(s7_pointer a1)); 848 s7_pointer s7_apply_n_2(s7_scheme *sc, s7_pointer args, s7_pointer (*f2)(s7_pointer a1, s7_pointer a2)); 849 s7_pointer s7_apply_n_3(s7_scheme *sc, s7_pointer args, s7_pointer (*f3)(s7_pointer a1, s7_pointer a2, s7_pointer a3)); 850 s7_pointer s7_apply_n_4(s7_scheme *sc, s7_pointer args, s7_pointer (*f4)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4)); 851 s7_pointer s7_apply_n_5(s7_scheme *sc, s7_pointer args, s7_pointer (*f5)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, s7_pointer a5)); 852 s7_pointer s7_apply_n_6(s7_scheme *sc, s7_pointer args, 853 s7_pointer (*f6)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, 854 s7_pointer a5, s7_pointer a6)); 855 s7_pointer s7_apply_n_7(s7_scheme *sc, s7_pointer args, 856 s7_pointer (*f7)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, 857 s7_pointer a5, s7_pointer a6, s7_pointer a7)); 858 s7_pointer s7_apply_n_8(s7_scheme *sc, s7_pointer args, 859 s7_pointer (*f8)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, 860 s7_pointer a5, s7_pointer a6, s7_pointer a7, s7_pointer a8)); 861 s7_pointer s7_apply_n_9(s7_scheme *sc, s7_pointer args, 862 s7_pointer (*f9)(s7_pointer a1, s7_pointer a2, s7_pointer a3, s7_pointer a4, 863 s7_pointer a5, s7_pointer a6, s7_pointer a7, s7_pointer a8, s7_pointer a9)); 864 865 #if WITH_GMP 866 #include <gmp.h> 867 #include <mpfr.h> 868 #include <mpc.h> 869 870 mpfr_t *s7_big_real(s7_pointer x); 871 mpz_t *s7_big_integer(s7_pointer x); 872 mpq_t *s7_big_ratio(s7_pointer x); 873 mpc_t *s7_big_complex(s7_pointer x); 874 875 bool s7_is_bignum(s7_pointer obj); 876 bool s7_is_big_real(s7_pointer x); 877 bool s7_is_big_integer(s7_pointer x); 878 bool s7_is_big_ratio(s7_pointer x); 879 bool s7_is_big_complex(s7_pointer x); 880 881 s7_pointer s7_make_big_real(s7_scheme *sc, mpfr_t *val); 882 s7_pointer s7_make_big_integer(s7_scheme *sc, mpz_t *val); 883 s7_pointer s7_make_big_ratio(s7_scheme *sc, mpq_t *val); 884 s7_pointer s7_make_big_complex(s7_scheme *sc, mpc_t *val); 885 #endif 886 887 888 /* -------------------------------------------------------------------------------- */ 889 890 #if (!DISABLE_DEPRECATED) 891 typedef s7_int s7_Int; 892 typedef s7_double s7_Double; 893 894 #define s7_is_object s7_is_c_object 895 #define s7_object_type s7_c_object_type 896 #define s7_object_value s7_c_object_value 897 #define s7_make_object s7_make_c_object 898 #define s7_mark_object s7_mark 899 #define s7_UNSPECIFIED(Sc) s7_unspecified(Sc) 900 #endif 901 902 903 /* -------------------------------------------------------------------------------- 904 * 905 * s7 changes 906 * 907 * 25-Jan: s7_define_semisafe_typed_function. 908 * 6-Jan-21: s7_hash_code. 909 * -------- 910 * 14-Oct: s7_load_c_string and s7_load_c_string_with_environment. 911 * 10-Sep: s7_free. 912 * 5-Aug: s7_make_list. 913 * 31-July: s7_define_constant_with_environment and s7_dilambda_with_environment. 914 * 29-July: open-input|output-function. add S7_NUM_READ_CHOICES to s7_read_t enum and remove (unused) S7_READ_BYTE. 915 * 20-July: s7_c_pointer_with_type. notcurses_s7.c and nrepl.scm. *autoload-hook*. 916 * 8-July: s7_int|float_vector_ref|set. subvector parameter order changed. 917 * 17-June: removed deprecated *s7* accessors. 918 * 20-May: libarb_s7.c. 919 * 12-May: s7_is_big*. 920 * 6-May: added s7_scheme* initial arguments to s7_set_* opt_func calls (s7_set_d_d_function for example). 921 * 23-Apr: added s7_scheme* initial argument to s7_is_eqv. 922 * 9-Mar: move openlets to (*s7* 'openlets), s7-version to (*s7* 'version), deprecate nan.0 and inf.0. 923 * 17-Feb: s7_let_field_ref|set for *s7* access. *function* to replace __func__. 924 * deprecate __func__, s7_print_length, s7_float_format_precision, s7_set_gc_stats. 925 * 31-Jan: macro(*) and bacro(*) -- unnamed macros analogous to lambda(*). 926 * 20-Jan: debug.scm and (*s7* 'debug), trace-in, dynamic-unwind. 927 * remove coverlets (openlets is now a dilambda). 928 * 10-Jan: s7_c_type_set_gc_free and s7_c_type_set_gc_mark. 929 * 2-Jan-20: s7_c_type_set_is_equal and s7_c_type_set_is_equivalent. 930 * -------- 931 * 2-Nov: s7_repl. 932 * 30-Oct: change S7_DATE format, and start updating it to reflect s7.c. 933 * 30-Jul: define-expansion*. 934 * 12-Jul: s7_call_with_catch, s7_load now returns NULL if file not found (rather than raise an error). 935 * 8-July: most-positive-fixnum and most-negative-fixnum moved to *s7*. 936 * 23-May: added s7_scheme argument to s7_c_object_set_let. 937 * 19-May: s7_gc_stats renamed s7_set_gc_stats. 938 * 7-May: s7_gc_unprotect_via_stack and s7_gc_(un)protect_via_location. 939 * 22-Mar: s7_float_format_precision. port-position. port-file. 940 * 4-Jan-19: morally-equal? -> equivalent? 941 * -------- 942 * 29-Dec: s7_c_type_set_getter|setter (implicit c-object access). 943 * 23-Dec: remove hash-table, rename hash-table* to hash-table. add weak-hash-table. 944 * 3-Dec: deprecate s7_gc_unprotect (use s7_gc_unprotect_at). 945 * 21-Nov: added s7_history_enabled and s7_set_history_enabled. 946 * 3-Nov: removed the "value" argument from s7_for_each_symbol. 947 * 22-Sep: s7_list_nl. 948 * 12-Sep: byte-vectors can be multidimensional; homogenous vectors of any built-in type. typed hash-tables. 949 * 29-Jul: symbol-setter deprecated (use setter). s7_symbol_documentation (and setter) folded into s7_documentation. 950 * 12-Jul: changed s7_vector_dimensions|offsets. 951 * Added s7_scheme* arg to make_permanent_string and several of the optimizer functions. 952 * 3-Jul: changed make-shared-vector to subvector. 953 * 20-May: s7_keyword_to_symbol. 954 * 6-May: s7_mark_c_object -> s7_mark. 955 * 26-Apr: s7_c_type_set_to_list|string, s7_c_type_set_apply -> s7_c_type_set_ref, removed s7_c_type_set_set|apply_direct 956 * c_type length|set|ref are now s7_functions (args, not obj, etc). 957 * 23-Mar: s7_peek_char and s7_read_char now return s7_pointer, s7_write_char takes s7_pointer, not int32_t c 958 * s7_gc_protect and friends now return/take s7_int location, not uint32_t. 959 * removed s7_new_type_x. 960 * 19-Mar: int32_t -> s7_int in various functions. 961 * 17-Mar: deprecate s7_ulong and s7_ulong_long functions. 962 * 26-Jan-18: s7_set_setter. 963 * -------- 964 * 11-Dec: s7_gc_protect_via_stack 965 * 3-Oct: renamed procedure-signature -> signature, procedure-documentation -> documentation, and procedure-setter -> setter. 966 * 18-Sep: s7_immutable, s7_is_immutable. define-constant follows lexical scope now. 967 * s7_symbol_access -> s7_symbol_setter, symbol-access -> symbol-setter. 968 * 3-Aug: object->c_object name changes. 969 * 28-Jul: s7_make_c_pointer_with_type and s7_c_pointer_type. 970 * 24-Jul: int64_t rather than long long int, and various related changes. 971 * 18-Jul: s7_make_object_with_let. 972 * 8-July: s7_define_typed_function_star, s7_make_function_star. s7_apply_function_star. 973 * 27-June: s7_make_string_wrapper. 974 * 22-May: lambda* keyword arg handling changed slightly. 975 * 9-May: s7_history, s7_add_to_history. 976 * 20-Apr: s7_tree_memq (for Snd), s7_type_of, many changes for new clm optimizer. 977 * 10-Apr: added s7_scheme first argument to s7_iterator_is_at_end. 978 * 28-Mar: removed the "rf", "pf" and "if" clm optimization functions. 979 * s7_optimize, s7_float_optimize, s7_procedure_signature. 980 * 22-Feb: removed the "gf" clm optimization functions. 981 * 11-Feb: #e, #i, #d removed. #i(...) is an int-vector constant, #r(...) a float-vector. 982 * 2-Jan-17: {apply_values} -> apply-values, {list} -> list-values, and {append} -> append. 983 * -------- 984 * 23-Sep: make-keyword -> string->keyword. 985 * 9-Aug: s7_varlet. 986 * 29-Jul: s7_define_unsafe_typed_function. 987 * 30-May: symbol takes any number of args. make-vector no longer takes an optional fourth argument. 988 * 24-May: let-ref/set! check rootlet now if let is not an open let; setter for with-let. 989 * 20-Feb: removed last vestiges of quasiquoted vector support. 990 * 3-Feb: *cload-directory*. 991 * 14-Jan: profile.scm. Moved multiple-value-set! to stuff.scm. Setter for port-line-number. 992 * 7-Jan: s7_load_with_environment. 993 * s7_eval_c_string takes only one statement now (use begin to handle multiple statements) 994 * 4-Jan-16: remove s7_eval_form, change s7_eval to take its place. 995 * -------- 996 * 11-Dec: owlet error-history field if WITH_HISTORY=1 997 * 6-Nov: removed :key and :optional. 998 * 16-Oct: s7_make_random_state -> s7_random_state. 999 * 16-Aug: remove s7_define_integer_function, s7_function_set_removes_temp, 1000 * add s7_define_typed_function, s7_make_signature. 1001 * 5-Aug: added s7_scheme* arg to s7_openlet and s7_outlet. 1002 * 3-Jul: s7_Double -> s7_double, s7_Int -> s7_int. Removed function_chooser_data. 1003 * 27-Jun: s7_rf_t, s7_rp_t etc. 1004 * 19-Jun: removed the ex_parser stuff, set_step_safe, s7_ex_fallback. 1005 * 5-May: s7_make_iterator and friends. 1006 * 16-Apr: added s7_fill, changed arg interpretation of s7_copy, s7_dynamic_wind. 1007 * 30-Mar: s7_eval_c_string_with_environment (repl experiment). 1008 * 19-Mar: repl.scm. 1009 * 28-Feb: s7_vector_print_length -> s7_print_length, set case also. 1010 * 25-Feb: s7_closure_* funcs to replace clumsy (deprecated) s7_procedure_source. 1011 * 29-Jan: changed args to s7_new_type_x (added s7_scheme arg, fill! takes s7_function). 1012 * 14-Jan-15: make-iterator, iterator? 1013 * -------- 1014 * 26-Dec: s7_arity replaces s7_procedure_arity. s7_define_integer_function. deprecate s7_procedure_name. 1015 * 5-Nov: s7_shadow_rootlet and s7_set_shadow_rootlet. 1016 * 30-Aug: s7_make_safe_function (for cload.scm). 1017 * 25-July: define and friends now return the value, not the symbol. 1018 * procedure_with_setter -> dilambda. 1019 * environment -> let. All the replaced names are deprecated. 1020 * 30-June: s7_method. 1021 * 16-June: remove unoptimize and s7_unoptimize. 1022 * 14-May: s7_define_safe_function_star. Removed s7_catch_all. 1023 * 22-Apr: remove s7_apply_n_10, s7_is_valid_pointer, s7_keyword_eq_p. 1024 * 5-Mar-14: s7_heap_size, s7_gc_freed (subsequently removed). 1025 * -------- 1026 * 8-Nov: s7_symbol_documentation, s7_define_constant_with_documentation. 1027 * 17-Oct: bignum-precision (procedure-with-setter) is now an integer variable named *bignum-precision*. 1028 * 28-Aug: s7_int|float_vector_elements (homogeneous vectors), libc.scm. 1029 * 16-Aug: ~W directive in format, make-shared-vector. 1030 * 23-Jul: s7_autoload_set_names, libm.scm, libdl.scm, libgdbm.scm, r7rs.scm, s7libtest.scm. 1031 * 21-Jul: s7_is_valid (replaces deprecated s7_is_valid_pointer). 1032 * 24-Jun: some bool-related changes for Windows Visual C++, including change to s7_begin_hook. 1033 * 3-June: s7_autoload. 1034 * 28-May: export s7_is_provided. Added s7_scheme* arg to s7_procedure_environment. 1035 * 21-May: equality predicate optional arg in make-hash-table. 1036 * 14-May: glistener.c, glistener.h, s7_symbol_table_find_name (for glistener). 1037 * 2-May: r7rs changes: flush-output-port, vector-append, read|write-string, boolean=?, symbol=?. 1038 * start/end args for string-fill!, vector-fill!, string->list, vector->list, and copy. 1039 * exit, emergency-exit. 1040 * 7-Apr: removed s7_scheme* arg from s7_slot_value, added s7_is_local_variable. 1041 * 25-Mar: char-position, string-position, environment-ref, environment-set! added to the scheme side. 1042 * 9-Jan-13: s7_cos, s7_sin, other optimization changes. 1043 * -------- 1044 * 24-Dec: s7_set_object_array_info and other such changes. 1045 * 20-Nov: removed s7_set_error_exiter and s7_error_and_exit which I think have never been used. 1046 * 22-Oct: changed args to s7_function_class and s7_function_set_class. 1047 * 22-Aug: symbol->dynamic-value. 1048 * 10-Aug: exported s7_outer_environment. 1049 * 6-Aug: removed WITH_OPTIMIZATION. 1050 * 25-July: environment (in scheme). s7_vector_ref_n and s7_vector_set_n. s7_copy. 1051 * added s7_scheme arg to s7_number_to_real|integer. 1052 * 16-July: s7_function_returns_temp (an experiment). 1053 * 2-July: s7_object_set_* functions. 1054 * 11-June: throw. 1055 * 4-June. s7_object_environment. 1056 * 31-May: added s7_scheme argument to all the optimizer chooser functions. 1057 * 24-May: open-environment? 1058 * 17-May: arity, aritable? 1059 * removed trace and untrace. 1060 * 14-May: s7_list. s7_procedure_set_setter. Removed s7_procedure_getter. 1061 * procedure-setter is settable: removed most of procedure-with-setter. 1062 * make-type replaced by open-environment. 1063 * 11-May: s7 2.0: hook implementation changed completely. 1064 * s7_environment_ref|set. 1065 * 4-May: *error-info* replaced by error-environment, and stacktrace has changed. 1066 * 22-Apr: #_<name> = startup (built-in) value of name 1067 * 17-Apr: with-baffle. 1068 * 14-Apr: WITH_SYSTEM_EXTRAS (default 0) has additional OS and IO functions: 1069 * directory? file-exists? delete-file getenv directory->list system 1070 * 26-Mar: "@" as exponent, WITH_AT_SIGN_AS_EXPONENT switch (default is 1). 1071 * 18-Mar: removed *trace-hook*. 1072 * 6-Feb: random-state?, hash-table-iterator?, and morally-equal? 1073 * 18-Jan: s7_environment_to_list and environment->list return just the local environment's bindings. 1074 * outer-environment returns the environment enclosing its argument (an environment). 1075 * environments are now applicable objects. 1076 * added the object system example to s7.html. 1077 * 12-Jan: added reverse argument to s7_new_type_x. This is needed because an object might implement 1078 * the apply and set methods, but they might refer to different things. 1079 * 6-Jan-12: added (scheme side) logbit?. 1080 * -------- 1081 * 21-Dec: s7_eval, s7_make_slot, s7_slot_set_value. 1082 * changed s7_symbol_slot to s7_slot, and s7_symbol_slot_value to s7_slot_value. 1083 * 26-Oct: s7_procedure_name. 1084 * 6-Oct: changed s7_make_closure args: split the code argument in two (args and body). 1085 * s7_make_closure(... code ...) is now s7_make_closure(... car(code), cdr(code) ...) 1086 * s7_is_environment. 1087 * 19-Aug: s7_function_chooser_data. 1088 * 11-Aug: s7_symbol_accessor functions. s7_cxxxxr. 1089 * 9-Aug: s7_function_chooser, s7_function_choice, s7_function_choice_set_direct. 1090 * 20-Jul: s7_function_class, s7_function_set_class, and s7_function_set_chooser. 1091 * 14-Jul: removed thread and profiling support. 1092 * 5-June: s7_define_safe_function and s7_unoptimize exported; added unoptimize function in scheme. 1093 * 30-May: environment->list and s7_environment_to_list since environments are no longer alists internally. 1094 * 26-May: added s7_scheme argument to s7_procedure_setter and getter (old names had "with_setter_"). 1095 * 28-Apr: s7_help. 1096 * 5-Apr: pair-line-number. 1097 * 14-Mar: s7_make_random_state, optional state argument to s7_random, random-state->list, s7_random_state_to_list. 1098 * 10-Feb: s7_vector_print_length, s7_set_vector_print_length. 1099 * 7-Feb: s7_begin_hook, s7_set_begin_hook. 1100 * 25-Jan: s7_is_thread, s7_thread, s7_make_thread, s7_thread_s7, s7_thread_data. 1101 * s7_is_lock, s7_make_lock, s7_lock. 1102 * changed s7_thread_variable_value to s7_thread_variable. 1103 * 23-Jan: removed (scheme-level) quit. 1104 * 17-Jan-11: make-hash-table-iterator. 1105 * map and for-each accept any applicable object as the first argument. 1106 * format's ~{...~} directive can handle any applicable object. 1107 * -------- 1108 * 17-Dec: removed unquote-splicing; replaced by (unquote (apply values ...)). 1109 * 12-Dec: environment? 1110 * 7-Dec: member and assoc have an optional third arg, the comparison function. 1111 * 1-Dec: *gc-stats* in Scheme, s7_gc_stats in C. 1112 * gmp and gtk-repl examples in s7.html. 1113 * 21-Nov: Load C module example in s7.html. 1114 * 12-Nov: *trace-hook*, *load-hook*, *error-hook*, and *unbound-variable-hook* are now s7 hooks. 1115 * 9-Nov: hooks: C side: s7_is_hook, s7_make_hook, s7_hook_apply, s7_hook_functions, s7_hook_arity, s7_hook_documentation. 1116 * s7 side: hook?, make-hook, hook, hook-apply, hook-functions, hook-arity, hook-documentation. 1117 * 8-Nov: Closure defined in C example in s7.html. 1118 * 23-Oct: s7_call_with_location for better error reporting. 1119 * 19-Oct: *stdin*, *stdout*, *stderr* for default IO ports (rather than nil which is ambiguous). 1120 * 14-Oct: removed special variable support. 1121 * 30-Sep: setters for current-input-port, current-output-port, and current-error-port. 1122 * 30-Aug: :allow-other-keys in define*. 1123 * 10-Aug: added boolean argument use_write to s7_object_to_string (true=write, false=display). 1124 * 30-July: special macro for access to dynamic binding. 1125 * s7_symbol_special_value for C-side access to dynamic bindings. 1126 * s7_is_macro. 1127 * port-closed? returns #t if its argument (a port) is closed. 1128 * 22-July: s7_make_character takes uint32_t, rather than int. 1129 * added symbol function for funny symbol names. 1130 * 12-July: initial-environment. 1131 * 7-July: removed force and delay: use slib. 1132 * 3-July: new backquote implementation. 1133 * 28-June: syntactic keywords (e.g. lambda) are applicable. 1134 * 7-June: changed key arg in s7_hash_table_ref|set to be s7_pointer, not const char*. 1135 * hash-tables can now handle any s7 object as the key. 1136 * map and for-each now pass a hash-table entry to the function, rather than an internal alist. 1137 * reverse of a hash-table reverses the keys and values (i.e. old value becomes new key, etc). 1138 * 2-June: removed procedure-with-setter-setter-arity and folded that info into procedure-arity (use cdddr). 1139 * 22-May: multidimensional vectors are no longer optional. 1140 * 9-May: s7_read_char and s7_peek_char have to return an int, not a char (<eof>=-1, but 255 is a legit char). 1141 * s7_write_char and s7_open_output_function have similar changes. 1142 * 3-May: *#readers* to customize #... reading. Also nan? and infinite?. 1143 * multidimensional vector constants using #nD(...): (#2D((1 2 3) (4 5 6)) 0 0) -> 1. 1144 * 13-Apr: removed hash-table|vector|string-for-each -- these are handled by for-each. 1145 * also removed vector-map -- map is generic, but always returns a list. 1146 * 12-Apr: removed immutable constant checks -- see s7.html. 1147 * 7-Apr: *unbound-variable-hook*. 1148 * augment-environment and s7_augment_environment. 1149 * 29-Mar: symbol-access, s7_symbol_access, s7_symbol_set_access. 1150 * C example of notification in s7.html. 1151 * 25-Mar: make-type. s7_is_equal now includes an s7_scheme pointer as its first argument. 1152 * 24-Mar: s7_is_defined. 1153 * 19-Mar: removed encapsulation mechanism and s7_define_set_function. 1154 * 18-Mar: added macro?. 1155 * 27-Feb: removed r4rs-style macro syntax. 1156 * 17-Feb: s7_number_to_integer. 1157 * 20-Jan-10: removed the stack function. 1158 * -------- 1159 * 16-Dec: hash-table-for-each. 1160 * 1-Dec: mpc versions before 0.8.0 are no longer supported. 1161 * 24-Nov: define-macro* and defmacro*. 1162 * force and delay included only if WITH_FORCE set, promise? removed. 1163 * 17-Nov: s7_is_boolean no longer takes the s7_scheme argument. 1164 * 7-Nov: s7_vector_dimensions, s7_vector_offsets, example of use. 1165 * 3-Nov: s7_vector_rank. 1166 * 30-Oct: *trace-hook*. 1167 * 12-Oct: s7_port_filename. 1168 * 5-Oct: s7_c_pointer and friends. 1169 * 14-Sep: s7_values, s7_make_continuation, and a better interrupt example. 1170 * vector-for-each, vector-map, string-for-each. 1171 * 7-Sep: s7_open_input_function. with-environment. receive. 1172 * 3-Sep: s7.html, s7-slib-init.scm. 1173 * s7_stacktrace in s7.h. 1174 * 27-Aug: vector and hash-table sizes are now s7_ints, rather than ints. 1175 * 20-Aug: s7_remove_from_heap. 1176 * 17-Aug: *error-info*. 1177 * 7-Aug: s7_define_function_with_setter. 1178 * s7_quit and example of signal handling. 1179 * 6-Aug: encapsulation. s7_define_set_function. s7_new_type_x. 1180 * generic function: copy, and length is generic. 1181 * 1-Aug: lower-case versions of s7_T and friends. 1182 * s7_define_macro. macroexpand. 1183 * strings are set-applicable (like vectors). 1184 * 31-Jul: *error-hook*. 1185 * 30-Jul: changed backtrace handling: removed backtrace stuff, added stacktrace. 1186 * removed gc-verbose and load-verbose replaced by *load-hook*. 1187 * 23-Jul: __func__. 1188 * 20-Jul: trace and untrace. 1189 * 14-Jul: replaced s7_make_closure_star with s7_define_function_star. 1190 * 29-Jun: s7_format declaration. 1191 * 12-May: s7_is_constant. 1192 * 20-Apr: changed rationalize to be both r5rs-acceptable and fast. 1193 * 6-Apr: added s7_make_permanent_string. 1194 * 14-Mar: removed s7_local_gc_protect and s7_local_gc_unprotect. 1195 * 4-Mar: multidimensional and applicable vectors. 1196 * 1-Mar: s7_random added to s7.h. 1197 * 29-Jan: s7_is_bignum and friends. 1198 * 26-Jan: added s7_scheme arg to s7_vector_fill. 1199 * 16-Jan: s7_is_ulong_long and friends for C pointers in 64-bit situations. 1200 * 9-Jan-09 multiprecision arithmetic (gmp, mpfr, mpc) on the WITH_GMP switch 1201 * -------- 1202 * 29-Dec: "+" specialization example, s7_apply_function. 1203 * 3-Dec: s7_open_output_function. 1204 * 30-Nov: s7_wrong_number_of_args_error. 1205 * 24-Nov: changed s7_make_counted_string to s7_make_string_with_length. 1206 * also added built-in format and define* 1207 * 10-Nov: s7_define_constant, 1208 * built-in (scheme-side) pi, most-positive-fixnum, most-negative-fixnum 1209 * 7-Nov: removed s7_is_immutable and friends, s7_reverse_in_place. 1210 * removed the s7_pointer arg to s7_gc_on. 1211 * added s7_UNSPECIFIED 1212 * 25-Oct: added name arg to s7_make_procedure_with_setter, 1213 * and s7_scheme arg to new_type print func. 1214 * 1-Oct-08 version 1.0 1215 */ 1216 1217 1218 #ifdef __cplusplus 1219 } 1220 #endif 1221 1222 #endif 1223