564 lines
24 KiB
C
564 lines
24 KiB
C
/*
|
|
*
|
|
* p r i m i t i v e s . c -- List of STk subrs
|
|
*
|
|
* Copyright © 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
|
*
|
|
*
|
|
* Permission to use, copy, modify, distribute,and license this
|
|
* software and its documentation for any purpose is hereby granted,
|
|
* provided that existing copyright notices are retained in all
|
|
* copies and that this notice is included verbatim in any
|
|
* distributions. No written agreement, license, or royalty fee is
|
|
* required for any of the authorized uses.
|
|
* This software is provided ``AS IS'' without express or implied
|
|
* warranty.
|
|
*
|
|
* Author: Erick Gallesio [eg@kaolin.unice.fr]
|
|
* Creation date: ??????
|
|
* Last file update: 3-Sep-1999 20:22 (eg)
|
|
*/
|
|
|
|
|
|
#include "stk.h"
|
|
|
|
struct Primitive {
|
|
char *name;
|
|
char type;
|
|
PRIMITIVE (*fct)();
|
|
};
|
|
|
|
#ifdef USE_HASH
|
|
extern PRIMITIVE STk_init_hash(void);
|
|
#endif
|
|
#ifdef USE_SOCKET
|
|
extern PRIMITIVE STk_init_socket(void);
|
|
#endif
|
|
#ifdef USE_BLT
|
|
extern PRIMITIVE STk_init_blt(void);
|
|
#endif
|
|
#ifdef USE_REGEXP
|
|
extern PRIMITIVE STk_init_sregexp(void);
|
|
#endif
|
|
#ifdef USE_PROCESS
|
|
extern PRIMITIVE STk_init_process(void);
|
|
#endif
|
|
#ifdef USE_POSIX
|
|
extern PRIMITIVE STk_init_posix(void);
|
|
#endif
|
|
#ifdef USE_HTML
|
|
extern PRIMITIVE STk_init_html(void);
|
|
#endif
|
|
#ifdef USE_PIXMAP
|
|
extern PRIMITIVE STk_init_pixmap(void);
|
|
#endif
|
|
#ifdef USE_JPEG
|
|
extern PRIMITIVE STk_init_jpeg(void);
|
|
#endif
|
|
#ifdef USE_BASE64
|
|
extern PRIMITIVE STk_init_base64(void);
|
|
#endif
|
|
#ifdef USE_LOCALE
|
|
extern PRIMITIVE STk_init_locale(void);
|
|
#endif
|
|
|
|
#ifdef DEBUG_STK
|
|
static PRIMITIVE STk_test_proc(SCM l, int len)
|
|
{
|
|
/* This procedure is a placeholder to make tests from the Scheme prompt */
|
|
/* It does not appear in a non debug interpreter */
|
|
|
|
|
|
return UNDEFINED;
|
|
}
|
|
#endif
|
|
|
|
|
|
|
|
static struct Primitive Scheme_primitives[] = {
|
|
|
|
/**** Section 4.1 ****/
|
|
{"quote", tc_syntax, STk_syntax_quote},
|
|
{"lambda", tc_syntax, STk_syntax_lambda},
|
|
{"if", tc_syntax, STk_syntax_if},
|
|
{"set!", tc_syntax, STk_syntax_setq},
|
|
|
|
/**** Section 4.2 ****/
|
|
{"cond", tc_syntax, STk_syntax_cond},
|
|
{"and", tc_syntax, STk_syntax_and},
|
|
{"or", tc_syntax, STk_syntax_or},
|
|
{"let", tc_syntax, STk_syntax_let},
|
|
{"let*", tc_syntax, STk_syntax_letstar},
|
|
{"letrec", tc_syntax, STk_syntax_letrec},
|
|
{"begin", tc_syntax, STk_syntax_begin},
|
|
{"delay", tc_syntax, STk_syntax_delay},
|
|
{"quasiquote", tc_syntax, STk_syntax_quasiquote},
|
|
{"while", tc_fsubr, STk_while},
|
|
{"until", tc_fsubr, STk_until},
|
|
{"extend-environment", tc_syntax, STk_syntax_extend_env}, /* + */
|
|
|
|
|
|
/**** Section 5 ****/
|
|
{"define", tc_syntax, STk_syntax_define},
|
|
|
|
/**** Section 6.1 ****/
|
|
{"boolean?", tc_subr_1, STk_booleanp},
|
|
{"not", tc_subr_1, STk_not},
|
|
|
|
/**** Section 6.2 ****/
|
|
{"eq?", tc_subr_2, STk_eq},
|
|
{"eqv?", tc_subr_2, STk_eqv},
|
|
{"equal?", tc_subr_2, STk_equal},
|
|
|
|
/**** Section 6.3 ****/
|
|
{"pair?", tc_subr_1, STk_pairp},
|
|
{"cons", tc_subr_2, STk_cons},
|
|
{"car", tc_subr_1, STk_car},
|
|
{"cdr", tc_subr_1, STk_cdr},
|
|
{"set-car!", tc_subr_2, STk_setcar},
|
|
{"set-cdr!", tc_subr_2, STk_setcdr},
|
|
{"caar", tc_subr_1, STk_caar},
|
|
{"cdar", tc_subr_1, STk_cdar},
|
|
{"cadr", tc_subr_1, STk_cadr},
|
|
{"cddr", tc_subr_1, STk_cddr},
|
|
{"caaar", tc_subr_1, STk_caaar},
|
|
{"cdaar", tc_subr_1, STk_cdaar},
|
|
{"cadar", tc_subr_1, STk_cadar},
|
|
{"cddar", tc_subr_1, STk_cddar},
|
|
{"caadr", tc_subr_1, STk_caadr},
|
|
{"cdadr", tc_subr_1, STk_cdadr},
|
|
{"caddr", tc_subr_1, STk_caddr},
|
|
{"cdddr", tc_subr_1, STk_cdddr},
|
|
{"caaaar", tc_subr_1, STk_caaaar},
|
|
{"cdaaar", tc_subr_1, STk_cdaaar},
|
|
{"cadaar", tc_subr_1, STk_cadaar},
|
|
{"cddaar", tc_subr_1, STk_cddaar},
|
|
{"caadar", tc_subr_1, STk_caadar},
|
|
{"cdadar", tc_subr_1, STk_cdadar},
|
|
{"caddar", tc_subr_1, STk_caddar},
|
|
{"cdddar", tc_subr_1, STk_cdddar},
|
|
{"caaadr", tc_subr_1, STk_caaadr},
|
|
{"cdaadr", tc_subr_1, STk_cdaadr},
|
|
{"cadadr", tc_subr_1, STk_cadadr},
|
|
{"cddadr", tc_subr_1, STk_cddadr},
|
|
{"caaddr", tc_subr_1, STk_caaddr},
|
|
{"cdaddr", tc_subr_1, STk_cdaddr},
|
|
{"cadddr", tc_subr_1, STk_cadddr},
|
|
{"cddddr", tc_subr_1, STk_cddddr},
|
|
{"null?", tc_subr_1, STk_nullp},
|
|
{"list?", tc_subr_1, STk_listp},
|
|
{"list", tc_lsubr, STk_list},
|
|
{"length", tc_subr_1, STk_list_length},
|
|
{"append", tc_lsubr, STk_append},
|
|
{"reverse", tc_subr_1, STk_reverse},
|
|
{"list-tail", tc_subr_2, STk_list_tail},
|
|
{"list-ref", tc_subr_2, STk_list_ref},
|
|
{"memq", tc_subr_2, STk_memq},
|
|
{"memv", tc_subr_2, STk_memv},
|
|
{"member", tc_subr_2, STk_member},
|
|
{"assq", tc_subr_2, STk_assq},
|
|
{"assv", tc_subr_2, STk_assv},
|
|
{"assoc", tc_subr_2, STk_assoc},
|
|
|
|
{"list*", tc_lsubr, STk_liststar}, /* + */
|
|
{"copy-tree", tc_subr_1, STk_copy_tree}, /* + */
|
|
{"last-pair", tc_subr_1, STk_last_pair}, /* + */
|
|
{"remq", tc_subr_2, STk_remq}, /* + */
|
|
{"remv", tc_subr_2, STk_remv}, /* + */
|
|
{"remove", tc_subr_2, STk_remove}, /* + */
|
|
{"append!", tc_lsubr, STk_dappend}, /* + */
|
|
|
|
/**** Section 6.4 ****/
|
|
{"symbol?", tc_subr_1, STk_symbolp},
|
|
{"symbol->string", tc_subr_1, STk_symbol2string},
|
|
{"string->symbol", tc_subr_1, STk_string2symbol},
|
|
{"string->uninterned-symbol", /* + */
|
|
tc_subr_1, STk_string2usymbol},
|
|
|
|
/**** Section 6.5 ****/
|
|
{"number?", tc_subr_1, STk_numberp},
|
|
{"complex?", tc_subr_1, STk_numberp},
|
|
{"real?", tc_subr_1, STk_numberp},
|
|
{"rational?", tc_subr_1, STk_numberp},
|
|
{"integer?", tc_subr_1, STk_integerp},
|
|
{"exact?", tc_subr_1, STk_exactp},
|
|
{"inexact?", tc_subr_1, STk_inexactp},
|
|
{"=", tc_ssubr, STk_numequal},
|
|
{"<", tc_ssubr, STk_lessp},
|
|
{">", tc_ssubr, STk_greaterp},
|
|
{"<=", tc_ssubr, STk_lessep},
|
|
{">=", tc_ssubr, STk_greaterep},
|
|
{"zero?", tc_subr_1, STk_zerop},
|
|
{"negative?", tc_subr_1, STk_negativep},
|
|
{"positive?", tc_subr_1, STk_positivep},
|
|
{"odd?", tc_subr_1, STk_oddp},
|
|
{"even?", tc_subr_1, STk_evenp},
|
|
{"max", tc_ssubr, STk_max},
|
|
{"min", tc_ssubr, STk_min},
|
|
{"+", tc_ssubr, STk_plus},
|
|
{"-", tc_ssubr, STk_difference},
|
|
{"*", tc_ssubr, STk_times},
|
|
{"/", tc_ssubr, STk_division},
|
|
{"abs", tc_subr_1, STk_absolute},
|
|
{"quotient", tc_subr_2, STk_quotient},
|
|
{"remainder", tc_subr_2, STk_remainder},
|
|
{"modulo", tc_subr_2, STk_modulo},
|
|
{"gcd", tc_ssubr, STk_gcd},
|
|
{"lcm", tc_ssubr, STk_lcm},
|
|
{"floor", tc_subr_1, STk_floor},
|
|
{"ceiling", tc_subr_1, STk_ceiling},
|
|
{"truncate", tc_subr_1, STk_truncate},
|
|
{"round", tc_subr_1, STk_round},
|
|
{"exp", tc_subr_1, STk_exp},
|
|
{"log", tc_subr_1, STk_log},
|
|
{"sin", tc_subr_1, STk_sin},
|
|
{"cos", tc_subr_1, STk_cos},
|
|
{"tan", tc_subr_1, STk_tan},
|
|
{"asin", tc_subr_1, STk_asin},
|
|
{"acos", tc_subr_1, STk_acos},
|
|
{"atan", tc_subr_1_or_2, STk_atan},
|
|
{"sqrt", tc_subr_1, STk_sqrt},
|
|
{"expt", tc_subr_2, STk_expt},
|
|
{"exact->inexact", tc_subr_1, STk_exact2inexact},
|
|
{"inexact->exact", tc_subr_1, STk_inexact2exact},
|
|
{"string->number", tc_subr_1_or_2, STk_string2number},
|
|
{"number->string", tc_subr_1_or_2, STk_number2string},
|
|
{"bignum?", tc_subr_1, STk_bignump}, /* + */
|
|
|
|
/**** Section 6.6 ****/
|
|
{"char?", tc_subr_1, STk_charp},
|
|
|
|
{"char=?", tc_subr_2, STk_chareq},
|
|
{"char<?", tc_subr_2, STk_charless},
|
|
{"char>?", tc_subr_2, STk_chargt},
|
|
{"char<=?", tc_subr_2, STk_charlesse},
|
|
{"char>=?", tc_subr_2, STk_chargte},
|
|
|
|
{"char-ci=?", tc_subr_2, STk_chareqi},
|
|
{"char-ci<?", tc_subr_2, STk_charlessi},
|
|
{"char-ci>?", tc_subr_2, STk_chargti},
|
|
{"char-ci<=?", tc_subr_2, STk_charlessei},
|
|
{"char-ci>=?", tc_subr_2, STk_chargtei},
|
|
|
|
{"char-alphabetic?", tc_subr_1, STk_char_alphap},
|
|
{"char-numeric?", tc_subr_1, STk_char_numericp},
|
|
{"char-whitespace?", tc_subr_1, STk_char_whitep},
|
|
{"char-upper-case?", tc_subr_1, STk_char_upperp},
|
|
{"char-lower-case?", tc_subr_1, STk_char_lowerp},
|
|
|
|
{"integer->char", tc_subr_1, STk_integer2char},
|
|
{"char->integer", tc_subr_1, STk_char2integer},
|
|
{"char-upcase", tc_subr_1, STk_char_upper},
|
|
{"char-downcase", tc_subr_1, STk_char_lower},
|
|
|
|
/**** Section 6.7 ****/
|
|
{"string?", tc_subr_1, STk_stringp},
|
|
|
|
{"make-string", tc_subr_1_or_2, STk_make_string},
|
|
{"string", tc_lsubr, STk_lstring},
|
|
{"string-length", tc_subr_1, STk_string_length},
|
|
{"string-ref", tc_subr_2, STk_string_ref},
|
|
{"string-set!", tc_subr_3, STk_string_set},
|
|
|
|
{"string=?", tc_subr_2, STk_streq},
|
|
{"string<?", tc_subr_2, STk_strless},
|
|
{"string>?", tc_subr_2, STk_strgt},
|
|
{"string<=?", tc_subr_2, STk_strlesse},
|
|
{"string>=?", tc_subr_2, STk_strgte},
|
|
|
|
{"string-ci=?", tc_subr_2, STk_streqi},
|
|
{"string-ci<?", tc_subr_2, STk_strlessi},
|
|
{"string-ci>?", tc_subr_2, STk_strgti},
|
|
{"string-ci<=?", tc_subr_2, STk_strlessei},
|
|
{"string-ci>=?", tc_subr_2, STk_strgtei},
|
|
|
|
{"substring", tc_subr_3, STk_substring},
|
|
{"string-append", tc_lsubr, STk_string_append},
|
|
{"string->list", tc_subr_1, STk_string2list},
|
|
{"list->string", tc_subr_1, STk_list2string},
|
|
{"string-copy", tc_subr_1, STk_string_copy},
|
|
{"string-fill!", tc_subr_2, STk_string_fill},
|
|
|
|
{"string-find?", tc_subr_2, STk_string_findp}, /* + */
|
|
{"string-index", tc_subr_2, STk_string_index}, /* + */
|
|
{"string-lower", tc_subr_1, STk_string_lower}, /* + */
|
|
{"string-upper", tc_subr_1, STk_string_upper}, /* + */
|
|
{"split-string", tc_subr_1_or_2, STk_split_string}, /* + */
|
|
|
|
/**** Section 6.8 ****/
|
|
{"vector?", tc_subr_1, STk_vectorp},
|
|
{"make-vector", tc_subr_1_or_2, STk_make_vector},
|
|
{"vector", tc_lsubr, STk_vector},
|
|
{"vector-length", tc_subr_1, STk_vector_length},
|
|
{"vector-ref", tc_subr_2, STk_vector_ref},
|
|
{"vector-set!", tc_subr_3, STk_vector_set},
|
|
{"vector->list", tc_subr_1, STk_vector2list},
|
|
{"list->vector", tc_subr_1, STk_list2vector},
|
|
{"vector-fill!", tc_subr_2, STk_vector_fill},
|
|
|
|
{"vector-copy", tc_subr_1, STk_vector_copy}, /* + */
|
|
{"vector-resize", tc_subr_2, STk_vector_resize}, /* + */
|
|
|
|
/**** Section 6.9 ****/
|
|
{"procedure?", tc_subr_1, STk_procedurep},
|
|
{"apply", tc_apply, NULL},
|
|
{"map", tc_lsubr, STk_map},
|
|
{"for-each", tc_lsubr, STk_for_each},
|
|
{"force", tc_subr_1, STk_force},
|
|
{"call-with-current-continuation",
|
|
tc_call_cc, NULL},
|
|
{"values", tc_lsubr, STk_values},
|
|
{"call-with-values", tc_subr_2, STk_call_with_values},
|
|
|
|
{"promise?", tc_subr_1, STk_promisep}, /* + */
|
|
{"continuation?", tc_subr_1, STk_continuationp}, /* + */
|
|
{"dynamic-wind", tc_subr_3, STk_dynamic_wind}, /* + */
|
|
{"catch", tc_fsubr, STk_catch}, /* + */
|
|
{"procedure-body", tc_subr_1, STk_procedure_body}, /* + */
|
|
|
|
/**** Section 6.10 ****/
|
|
{"input-port?", tc_subr_1, STk_input_portp},
|
|
{"output-port?", tc_subr_1, STk_output_portp},
|
|
{"current-input-port", tc_subr_0, STk_current_input_port},
|
|
{"current-output-port", tc_subr_0, STk_current_output_port},
|
|
{"with-input-from-file", tc_subr_2, STk_with_input_from_file},
|
|
{"with-output-to-file", tc_subr_2, STk_with_output_to_file},
|
|
{"open-input-file", tc_subr_1, STk_open_input_file},
|
|
{"open-output-file", tc_subr_1, STk_open_output_file},
|
|
{"close-input-port", tc_subr_1, STk_close_input_port},
|
|
{"close-output-port", tc_subr_1, STk_close_output_port},
|
|
{"read", tc_subr_0_or_1, STk_read},
|
|
{"read-char", tc_subr_0_or_1, STk_read_char},
|
|
{"peek-char", tc_subr_0_or_1, STk_peek_char},
|
|
{"eof-object?", tc_subr_1, STk_eof_objectp},
|
|
{"char-ready?", tc_subr_0_or_1, STk_char_readyp},
|
|
{"write", tc_subr_1_or_2, STk_write},
|
|
{"display", tc_subr_1_or_2, STk_display},
|
|
{"newline", tc_subr_0_or_1, STk_newline},
|
|
{"write-char", tc_subr_1_or_2, STk_write_char},
|
|
{"load", tc_subr_1_or_2, STk_load},
|
|
|
|
{"input-file-port?", tc_subr_1, STk_input_file_portp}, /* + */
|
|
{"output-file-port?", tc_subr_1, STk_output_file_portp}, /* + */
|
|
{"with-input-from-port", tc_subr_2, STk_with_input_from_port}, /* + */
|
|
{"with-output-to-port", tc_subr_2, STk_with_output_to_port}, /* + */
|
|
{"with-error-to-port", tc_subr_2, STk_with_error_to_port}, /* + */
|
|
{"open-file", tc_subr_2, STk_open_file}, /* + */
|
|
{"close-port", tc_subr_1, STk_close_port}, /* + */
|
|
{"port-closed?", tc_subr_1, STk_port_closedp}, /* + */
|
|
{"read-line", tc_subr_0_or_1, STk_read_line}, /* + */
|
|
{"copy-port", tc_subr_2, STk_copy_port}, /* + */
|
|
{"flush", tc_subr_0_or_1, STk_flush}, /* + */
|
|
{"try-load", tc_subr_1_or_2, STk_try_load}, /* + */
|
|
{"autoload", tc_fsubr, STk_autoload}, /* + */
|
|
{"autoload?", tc_subr_1_or_2, STk_autoloadp}, /* + */
|
|
#if defined(USE_TK) && !defined(WIN32)
|
|
{"when-port-readable", tc_subr_1_or_2, STk_when_port_readable}, /* + */
|
|
{"when-port-writable", tc_subr_1_or_2, STk_when_port_writable}, /* + */
|
|
#endif
|
|
{"format", tc_lsubr, STk_format}, /* + */
|
|
{"error", tc_lsubr, STk_error}, /* + */
|
|
{"write*", tc_subr_1_or_2, STk_write_star}, /* + */
|
|
{"input-string-port?", tc_subr_1, STk_input_string_portp}, /* + */
|
|
{"output-string-port?", tc_subr_1, STk_output_string_portp}, /* + */
|
|
{"with-error-to-file", tc_subr_2, STk_with_error_to_file}, /* + */
|
|
{"current-error-port", tc_subr_0, STk_current_error_port}, /* + */
|
|
{"open-input-string", tc_subr_1, STk_open_input_string}, /* + */
|
|
{"open-output-string", tc_subr_0, STk_open_output_string}, /* + */
|
|
{"get-output-string", tc_subr_1, STk_get_output_string}, /* + */
|
|
{"with-input-from-string",tc_subr_2, STk_with_input_from_string},/* + */
|
|
{"with-output-to-string", tc_subr_1, STk_with_output_to_string}, /* + */
|
|
{"with-error-to-string", tc_subr_1, STk_with_error_to_string}, /* + */
|
|
{"read-from-string", tc_subr_1, STk_read_from_string}, /* + */
|
|
|
|
{"open-input-virtual", tc_lsubr, STk_open_input_virtual}, /* + */
|
|
{"open-output-virtual", tc_lsubr, STk_open_output_virtual}, /* + */
|
|
{"input-virtual-port?", tc_subr_1, STk_input_virtual_portp}, /* + */
|
|
{"output-virtual-port?", tc_subr_1, STk_output_virtual_portp}, /* + */
|
|
|
|
/**** Section 6.11 ****/
|
|
{"keyword?", tc_subr_1, STk_keywordp}, /* + */
|
|
{"make-keyword", tc_subr_1, STk_make_keyword}, /* + */
|
|
{"keyword->string", tc_subr_1, STk_keyword2string}, /* + */
|
|
{"get-keyword", tc_subr_2_or_3, STk_get_keyword}, /* + */
|
|
|
|
/**** Section 6.12 ****/
|
|
#ifdef USE_TK
|
|
{"widget->string", tc_subr_1, STk_widget2string}, /* + */
|
|
{"string->widget", tc_subr_1, STk_string2widget}, /* + */
|
|
{"tk-command?", tc_subr_1, STk_tk_commandp}, /* + */
|
|
{"widget-name", tc_subr_1, STk_widget_name}, /* + */
|
|
{"get-widget-data", tc_subr_1, STk_get_widget_data}, /* + */
|
|
{"set-widget-data!", tc_subr_2, STk_set_widget_data}, /* + */
|
|
#endif
|
|
|
|
/**** Section 6.13 ****/
|
|
{"environment?", tc_subr_1, STk_environmentp}, /* + */
|
|
{"the-environment", tc_fsubr, STk_the_environment}, /* + */
|
|
{"parent-environment", tc_subr_1, STk_parent_environment}, /* + */
|
|
{"global-environment", tc_subr_0, STk_global_environment}, /* + */
|
|
{"environment->list", tc_subr_1, STk_environment2list}, /* + */
|
|
{"procedure-environment", tc_subr_1, STk_procedure_environment}, /* + */
|
|
{"symbol-bound?", tc_subr_1_or_2, STk_symbol_boundp}, /* + */
|
|
{"eval", tc_subr_1_or_2, STk_user_eval}, /* + */
|
|
{"eval-hook", tc_subr_3, STk_eval_hook}, /* + */
|
|
|
|
{"define-module", tc_fsubr, STk_define_module}, /* + */
|
|
{"module?", tc_subr_1, STk_modulep}, /* + */
|
|
{"with-module", tc_fsubr, STk_with_module}, /* + */
|
|
{"import", tc_fsubr, STk_import}, /* + */
|
|
{"export-symbol", tc_subr_2, STk_export_symbol}, /* + */
|
|
{"export-all-symbols", tc_subr_0, STk_export_all_symbols}, /* + */
|
|
{"select-module", tc_fsubr, STk_select_module}, /* + */
|
|
{"current-module", tc_fsubr, STk_current_module}, /* + */
|
|
{"find-module", tc_subr_1_or_2, STk_find_module}, /* + */
|
|
{"module-name", tc_subr_1, STk_module_name}, /* + */
|
|
{"module-imports", tc_subr_1, STk_module_imports}, /* + */
|
|
{"module-exports", tc_subr_1, STk_module_exports}, /* + */
|
|
{"module-environment", tc_subr_1, STk_module_env}, /* + */
|
|
{"module-symbols", tc_subr_1, STk_module_symbols}, /* + */
|
|
{"all-modules", tc_subr_0, STk_all_modules}, /* + */
|
|
{"%get-module", tc_subr_1, STk_get_module}, /* Undoc */
|
|
|
|
/**** Section 6.14 ****/
|
|
{"macro", tc_fsubr, STk_macro}, /* + */
|
|
{"macro?", tc_subr_1, STk_macrop}, /* + */
|
|
{"macro-expand", tc_fsubr, STk_macro_expand}, /* + */
|
|
{"macro-expand-1", tc_fsubr, STk_macro_expand_1}, /* + */
|
|
{"macro-body", tc_subr_1, STk_macro_body}, /* + */
|
|
{"%macro-r5", tc_fsubr, STk_macro_R5}, /* Undoc */
|
|
|
|
/**** Section 6.15 ****/
|
|
{"address-of", tc_subr_1, STk_address_of}, /* + */
|
|
{"address?", tc_subr_1, STk_addressp}, /* + */
|
|
|
|
/**** Section 6.16 ****/
|
|
{"set-signal-handler!", tc_subr_2, STk_set_signal_handler}, /* + */
|
|
{"add-signal-handler!", tc_subr_2, STk_add_signal_handler}, /* + */
|
|
{"get-signal-handlers", tc_subr_0_or_1, STk_get_signal_handlers}, /* + */
|
|
{"send-signal", tc_subr_1, STk_send_signal}, /* + */
|
|
|
|
/**** Section 6.17 ****/
|
|
{"getcwd", tc_subr_0, STk_getcwd}, /* + */
|
|
{"chdir", tc_subr_1, STk_chdir}, /* + */
|
|
{"getpid", tc_subr_0, STk_getpid}, /* + */
|
|
{"expand-file-name", tc_subr_1, STk_expand_file_name}, /* + */
|
|
{"canonical-path", tc_subr_1, STk_canonical_path}, /* + */
|
|
{"system", tc_subr_1, STk_system}, /* + */
|
|
{"getenv", tc_subr_1, STk_getenv}, /* + */
|
|
{"setenv!", tc_subr_2, STk_setenv}, /* + */
|
|
{"file-is-directory?", tc_subr_1, STk_file_is_directoryp}, /* + */
|
|
{"file-is-regular?", tc_subr_1, STk_file_is_regularp}, /* + */
|
|
{"file-is-readable?", tc_subr_1, STk_file_is_readablep}, /* + */
|
|
{"file-is-writable?", tc_subr_1, STk_file_is_writablep}, /* + */
|
|
{"file-is-executable?", tc_subr_1, STk_file_is_executablep}, /* + */
|
|
{"file-exists?", tc_subr_1, STk_file_existp}, /* + */
|
|
{"glob", tc_lsubr, STk_file_glob}, /* + */
|
|
{"remove-file", tc_subr_1, STk_remove_file}, /* + */
|
|
{"rename-file", tc_subr_2, STk_rename_file}, /* + */
|
|
{"temporary-file-name", tc_subr_0, STk_temporary_file_name}, /* + */
|
|
|
|
|
|
/**** Section 6.23 (FFI) ****/
|
|
{"%call-external", tc_lsubr, STk_call_external}, /* Undoc */
|
|
{"%external-exists?", tc_subr_2, STk_external_existsp}, /* Undoc */
|
|
{"c-string->string", tc_subr_1, STk_cstring2string}, /* + */
|
|
|
|
/**** Section 6.24 (Misc) ****/
|
|
{"eval-string", tc_subr_1_or_2, STk_eval_string}, /* + */
|
|
{"gc", tc_subr_0, STk_gc}, /* + */
|
|
{"gc-stats", tc_subr_0, STk_gc_stats}, /* + */
|
|
{"expand-heap", tc_subr_1, STk_expand_heap}, /* + */
|
|
{"version", tc_subr_0, STk_version}, /* + */
|
|
{"machine-type", tc_subr_0, STk_machine_type}, /* + */
|
|
{"random", tc_subr_1, STk_random}, /* + */
|
|
{"set-random-seed!", tc_subr_1, STk_set_random_seed}, /* + */
|
|
{"sort", tc_subr_2, STk_sort}, /* + */
|
|
{"dump", tc_subr_1, STk_dump}, /* + */
|
|
{"get-internal-info", tc_subr_0, STk_get_internal_info}, /* + */
|
|
{"time", tc_fsubr, STk_time}, /* + */
|
|
{"uncode", tc_subr_1, STk_uncode}, /* + */
|
|
{"exit", tc_subr_0_or_1, STk_quit_interpreter}, /* + */
|
|
#ifdef USE_TK
|
|
{"trace-var", tc_subr_2, STk_trace_var}, /* + */
|
|
{"untrace-var", tc_subr_1, STk_untrace_var}, /* + */
|
|
#endif
|
|
|
|
/**** Undocumented primitives */
|
|
{"%get-eval-stack", tc_subr_0, STk_user_get_eval_stack}, /* Undoc */
|
|
{"%get-environment-stack",tc_subr_0, STk_get_env_stack}, /* Undoc */
|
|
{"%library-location", tc_subr_0, STk_library_location}, /* Undoc */
|
|
{"%procedure-arity", tc_subr_1, STk_procedure_arity}, /* Undoc */
|
|
{"%get-selected-module", tc_subr_0, STk_get_selected_module}, /* Undoc */
|
|
#ifdef USE_TK
|
|
{"%change-standard-ports",tc_subr_3, STk_change_standard_ports}, /* Undoc */
|
|
#endif
|
|
#ifdef DEBUG_STK
|
|
{"%find-cells", tc_subr_1, STk_find_cells}, /* for debug */
|
|
{"%get-environment", tc_subr_1, STk_get_environment},/* for debug */
|
|
{"%test-proc", tc_lsubr, STk_test_proc}, /* for debug */
|
|
#endif
|
|
|
|
|
|
#ifdef USE_STKLOS
|
|
{"%init-stklos", tc_subr_0, STk_init_STklos},
|
|
#endif
|
|
|
|
#ifdef USE_HASH
|
|
{"%init-hash", tc_subr_0, STk_init_hash},
|
|
#endif
|
|
#ifdef USE_SOCKET
|
|
{"%init-socket", tc_subr_0, STk_init_socket},
|
|
#endif
|
|
#ifdef USE_BLT
|
|
{"%init-blt", tc_subr_0, STk_init_blt},
|
|
#endif
|
|
#ifdef USE_REGEXP
|
|
{"%init-regexp", tc_subr_0, STk_init_sregexp},
|
|
#endif
|
|
#ifdef USE_PROCESS
|
|
{"%init-process", tc_subr_0, STk_init_process},
|
|
#endif
|
|
#ifdef USE_POSIX
|
|
{"%init-posix", tc_subr_0, STk_init_posix},
|
|
#endif
|
|
#ifdef USE_HTML
|
|
{"%init-html", tc_subr_0, STk_init_html},
|
|
#endif
|
|
#if defined(USE_TK) && defined(USE_PIXMAP)
|
|
{"%init-pixmap", tc_subr_0, STk_init_pixmap},
|
|
#endif
|
|
#if defined(USE_TK) && defined(USE_JPEG)
|
|
{"%init-jpeg", tc_subr_0, STk_init_jpeg},
|
|
#endif
|
|
#ifdef USE_BASE64
|
|
{"%init-base64", tc_subr_0, STk_init_base64},
|
|
#endif
|
|
#ifdef USE_locale
|
|
{"%init-locale", tc_subr_0, STk_init_locale},
|
|
#endif
|
|
{ "", 0, (SCM (*)()) NULL }
|
|
};
|
|
|
|
void STk_init_primitives(void)
|
|
{
|
|
register struct Primitive *p;
|
|
register SCM var, z;
|
|
|
|
for (p = Scheme_primitives; *p->name; p++) {
|
|
/* Create a subr cell and store it in both the STk and Scheme modules */
|
|
NEWCELL(z, p->type);
|
|
z->storage_as.subr.name = p->name;
|
|
z->storage_as.subr0.f = p->fct;
|
|
|
|
/* Normal calls should be
|
|
* STk_define_variable(p->name, z, STk_scheme_module);
|
|
* STk_define_variable(p->name, z, NIL);
|
|
* but it sucks; use low level access instead.
|
|
*/
|
|
var = Intern(p->name);
|
|
STk_define_public_var(STk_scheme_module, var, z);
|
|
VCELL(var) = z;
|
|
}
|
|
}
|