core: Split-out builtins.c.
* src/mes.c make_builtin_type, make_builtin, builtin_name, builtin_arity, builtin_function, builtin_p, builtin_printer, init_builtin, mes_builtins): Move to .. * src/builtins.c: New file. * build-aux/configure-lib.sh (mes_SOURCES): Add it. * build-aux/snarf.sh: Likewise. * build-aux/build-mes.sh (mes_sources): Remove. Include configure-lib.sh * include/mes/builtins.h: Remove constants. * include/mes/mes.h: Add prototypes. * include/mes/constants.h (cell_symbol_test): Rename from cell_test. * simple.make: New file.
This commit is contained in:
Jan (janneke) Nieuwenhuizen
parent
3470e47561
commit
94143959af
|
|
@ -33,7 +33,18 @@
|
|||
*.mini-hex2
|
||||
*.a
|
||||
*.o
|
||||
*.h.m2
|
||||
*.c.m2
|
||||
*.seed-out
|
||||
*.stderr
|
||||
*.stdout
|
||||
|
||||
*.x86-out
|
||||
|
||||
/TAGS
|
||||
|
||||
/lib/x86-mes/0exit-42
|
||||
/lib/x86-mes/exit-42
|
||||
|
||||
/lib/tests/*/[0-9a][0-9a-z]-*
|
||||
!/lib/tests/*/*.c
|
||||
|
|
@ -56,7 +67,6 @@
|
|||
/.store
|
||||
/.tarball-version
|
||||
|
||||
/out
|
||||
?
|
||||
?.mes
|
||||
\#*#
|
||||
|
|
|
|||
|
|
@ -30,24 +30,11 @@ fi
|
|||
. ./config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
. ${srcdest}build-aux/cc.sh
|
||||
. ${srcdest}build-aux/configure-lib.sh
|
||||
|
||||
trap 'test -f .log && cat .log' EXIT
|
||||
|
||||
mes_sources="
|
||||
src/gc.c
|
||||
src/hash.c
|
||||
src/lib.c
|
||||
src/math.c
|
||||
src/mes.c
|
||||
src/module.c
|
||||
src/posix.c
|
||||
src/reader.c
|
||||
src/string.c
|
||||
src/struct.c
|
||||
src/vector.c
|
||||
"
|
||||
|
||||
for c in $mes_sources; do
|
||||
for c in $mes_SOURCES; do
|
||||
compile $c
|
||||
done
|
||||
if test $mes_libc = system; then
|
||||
|
|
|
|||
|
|
@ -429,6 +429,7 @@ lib/linux/symlink.c
|
|||
fi
|
||||
|
||||
mes_SOURCES="
|
||||
src/builtins.c
|
||||
src/gc.c
|
||||
src/hash.c
|
||||
src/lib.c
|
||||
|
|
|
|||
|
|
@ -23,14 +23,15 @@ set -e
|
|||
. ${srcdest}build-aux/config.sh
|
||||
. ${srcdest}build-aux/trace.sh
|
||||
|
||||
trace "SNARF$snarf gc.c" ${srcdest}build-aux/mes-snarf.scm src/gc.c
|
||||
trace "SNARF$snarf hash.c" ${srcdest}build-aux/mes-snarf.scm src/hash.c
|
||||
trace "SNARF$snarf lib.c" ${srcdest}build-aux/mes-snarf.scm src/lib.c
|
||||
trace "SNARF$snarf math.c" ${srcdest}build-aux/mes-snarf.scm src/math.c
|
||||
trace "SNARF$snarf mes.c" ${srcdest}build-aux/mes-snarf.scm src/mes.c
|
||||
trace "SNARF$snarf module.c" ${srcdest}build-aux/mes-snarf.scm src/module.c
|
||||
trace "SNARF$snarf posix.c" ${srcdest}build-aux/mes-snarf.scm src/posix.c
|
||||
trace "SNARF$snarf reader.c" ${srcdest}build-aux/mes-snarf.scm src/reader.c
|
||||
trace "SNARF$snarf strings.c" ${srcdest}build-aux/mes-snarf.scm src/string.c
|
||||
trace "SNARF$snarf struct.c" ${srcdest}build-aux/mes-snarf.scm src/struct.c
|
||||
trace "SNARF$snarf vector.c" ${srcdest}build-aux/mes-snarf.scm src/vector.c
|
||||
trace "SNARF$snarf builtins.c" ${srcdest}build-aux/mes-snarf.scm src/builtins.c
|
||||
trace "SNARF$snarf gc.c" ${srcdest}build-aux/mes-snarf.scm src/gc.c
|
||||
trace "SNARF$snarf hash.c" ${srcdest}build-aux/mes-snarf.scm src/hash.c
|
||||
trace "SNARF$snarf lib.c" ${srcdest}build-aux/mes-snarf.scm src/lib.c
|
||||
trace "SNARF$snarf math.c" ${srcdest}build-aux/mes-snarf.scm src/math.c
|
||||
trace "SNARF$snarf mes.c" ${srcdest}build-aux/mes-snarf.scm src/mes.c
|
||||
trace "SNARF$snarf module.c" ${srcdest}build-aux/mes-snarf.scm src/module.c
|
||||
trace "SNARF$snarf posix.c" ${srcdest}build-aux/mes-snarf.scm src/posix.c
|
||||
trace "SNARF$snarf reader.c" ${srcdest}build-aux/mes-snarf.scm src/reader.c
|
||||
trace "SNARF$snarf strings.c" ${srcdest}build-aux/mes-snarf.scm src/string.c
|
||||
trace "SNARF$snarf struct.c" ${srcdest}build-aux/mes-snarf.scm src/struct.c
|
||||
trace "SNARF$snarf vector.c" ${srcdest}build-aux/mes-snarf.scm src/vector.c
|
||||
|
|
|
|||
|
|
@ -21,10 +21,15 @@
|
|||
#ifndef __MES_BUILTINS_H
|
||||
#define __MES_BUILTINS_H
|
||||
|
||||
// src/gc.mes
|
||||
/* src/builtins.mes */
|
||||
SCM make_builtin (SCM builtin_type, SCM name, SCM arity, SCM function);
|
||||
SCM builtin_arity (SCM builtin);
|
||||
SCM builtin_p (SCM x);
|
||||
SCM builtin_printer (SCM builtin);
|
||||
/* src/gc.mes */
|
||||
SCM gc_check ();
|
||||
SCM gc ();
|
||||
// src/hash.mes
|
||||
/* src/hash.mes */
|
||||
SCM hashq (SCM x, SCM size);
|
||||
SCM hash (SCM x, SCM size);
|
||||
SCM hashq_get_handle (SCM table, SCM key, SCM dflt);
|
||||
|
|
@ -34,7 +39,7 @@ SCM hashq_set_x (SCM table, SCM key, SCM value);
|
|||
SCM hash_set_x (SCM table, SCM key, SCM value);
|
||||
SCM hash_table_printer (SCM table);
|
||||
SCM make_hash_table (SCM x);
|
||||
// src/lib.mes
|
||||
/* src/lib.mes */
|
||||
SCM procedure_name_ (SCM x);
|
||||
SCM display_ (SCM x);
|
||||
SCM display_error_ (SCM x);
|
||||
|
|
@ -52,7 +57,7 @@ SCM memq (SCM x, SCM a);
|
|||
SCM equal2_p (SCM a, SCM b);
|
||||
SCM last_pair (SCM x);
|
||||
SCM pair_p (SCM x);
|
||||
// src/math.mes
|
||||
/* src/math.mes */
|
||||
SCM greater_p (SCM x);
|
||||
SCM less_p (SCM x);
|
||||
SCM is_p (SCM x);
|
||||
|
|
@ -66,7 +71,7 @@ SCM logior (SCM x);
|
|||
SCM lognot (SCM x);
|
||||
SCM logxor (SCM x);
|
||||
SCM ash (SCM n, SCM count);
|
||||
// src/mes.mes
|
||||
/* src/mes.mes */
|
||||
SCM make_cell_ (SCM type, SCM car, SCM cdr);
|
||||
SCM type_ (SCM x);
|
||||
SCM car_ (SCM x);
|
||||
|
|
@ -95,254 +100,13 @@ SCM set_env_x (SCM x, SCM e, SCM a);
|
|||
SCM macro_get_handle (SCM name);
|
||||
SCM add_formals (SCM formals, SCM x);
|
||||
SCM eval_apply ();
|
||||
SCM make_builtin_type ();
|
||||
SCM make_builtin (SCM builtin_type, SCM name, SCM arity, SCM function);
|
||||
SCM builtin_arity (SCM builtin);
|
||||
SCM builtin_p (SCM x);
|
||||
SCM builtin_printer (SCM builtin);
|
||||
// CONSTANT cell_nil 1
|
||||
#define cell_nil 1
|
||||
// CONSTANT cell_f 2
|
||||
#define cell_f 2
|
||||
// CONSTANT cell_t 3
|
||||
#define cell_t 3
|
||||
// CONSTANT cell_dot 4
|
||||
#define cell_dot 4
|
||||
// CONSTANT cell_arrow 5
|
||||
#define cell_arrow 5
|
||||
// CONSTANT cell_undefined 6
|
||||
#define cell_undefined 6
|
||||
// CONSTANT cell_unspecified 7
|
||||
#define cell_unspecified 7
|
||||
// CONSTANT cell_closure 8
|
||||
#define cell_closure 8
|
||||
// CONSTANT cell_circular 9
|
||||
#define cell_circular 9
|
||||
// CONSTANT cell_begin 10
|
||||
#define cell_begin 10
|
||||
// CONSTANT cell_call_with_current_continuation 11
|
||||
#define cell_call_with_current_continuation 11
|
||||
// CONSTANT cell_vm_apply 12
|
||||
#define cell_vm_apply 12
|
||||
// CONSTANT cell_vm_apply2 13
|
||||
#define cell_vm_apply2 13
|
||||
// CONSTANT cell_vm_begin 14
|
||||
#define cell_vm_begin 14
|
||||
// CONSTANT cell_vm_begin_eval 15
|
||||
#define cell_vm_begin_eval 15
|
||||
// CONSTANT cell_vm_begin_expand 16
|
||||
#define cell_vm_begin_expand 16
|
||||
// CONSTANT cell_vm_begin_expand_eval 17
|
||||
#define cell_vm_begin_expand_eval 17
|
||||
// CONSTANT cell_vm_begin_expand_macro 18
|
||||
#define cell_vm_begin_expand_macro 18
|
||||
// CONSTANT cell_vm_begin_expand_primitive_load 19
|
||||
#define cell_vm_begin_expand_primitive_load 19
|
||||
// CONSTANT cell_vm_begin_primitive_load 20
|
||||
#define cell_vm_begin_primitive_load 20
|
||||
// CONSTANT cell_vm_begin_read_input_file 21
|
||||
#define cell_vm_begin_read_input_file 21
|
||||
// CONSTANT cell_vm_call_with_current_continuation2 22
|
||||
#define cell_vm_call_with_current_continuation2 22
|
||||
// CONSTANT cell_vm_call_with_values2 23
|
||||
#define cell_vm_call_with_values2 23
|
||||
// CONSTANT cell_vm_eval 24
|
||||
#define cell_vm_eval 24
|
||||
// CONSTANT cell_vm_eval2 25
|
||||
#define cell_vm_eval2 25
|
||||
// CONSTANT cell_vm_eval_check_func 26
|
||||
#define cell_vm_eval_check_func 26
|
||||
// CONSTANT cell_vm_eval_define 27
|
||||
#define cell_vm_eval_define 27
|
||||
// CONSTANT cell_vm_eval_macro_expand_eval 28
|
||||
#define cell_vm_eval_macro_expand_eval 28
|
||||
// CONSTANT cell_vm_eval_macro_expand_expand 29
|
||||
#define cell_vm_eval_macro_expand_expand 29
|
||||
// CONSTANT cell_vm_eval_pmatch_car 30
|
||||
#define cell_vm_eval_pmatch_car 30
|
||||
// CONSTANT cell_vm_eval_pmatch_cdr 31
|
||||
#define cell_vm_eval_pmatch_cdr 31
|
||||
// CONSTANT cell_vm_eval_set_x 32
|
||||
#define cell_vm_eval_set_x 32
|
||||
// CONSTANT cell_vm_evlis 33
|
||||
#define cell_vm_evlis 33
|
||||
// CONSTANT cell_vm_evlis2 34
|
||||
#define cell_vm_evlis2 34
|
||||
// CONSTANT cell_vm_evlis3 35
|
||||
#define cell_vm_evlis3 35
|
||||
// CONSTANT cell_vm_if 36
|
||||
#define cell_vm_if 36
|
||||
// CONSTANT cell_vm_if_expr 37
|
||||
#define cell_vm_if_expr 37
|
||||
// CONSTANT cell_vm_macro_expand 38
|
||||
#define cell_vm_macro_expand 38
|
||||
// CONSTANT cell_vm_macro_expand_car 39
|
||||
#define cell_vm_macro_expand_car 39
|
||||
// CONSTANT cell_vm_macro_expand_cdr 40
|
||||
#define cell_vm_macro_expand_cdr 40
|
||||
// CONSTANT cell_vm_macro_expand_define 41
|
||||
#define cell_vm_macro_expand_define 41
|
||||
// CONSTANT cell_vm_macro_expand_define_macro 42
|
||||
#define cell_vm_macro_expand_define_macro 42
|
||||
// CONSTANT cell_vm_macro_expand_lambda 43
|
||||
#define cell_vm_macro_expand_lambda 43
|
||||
// CONSTANT cell_vm_macro_expand_set_x 44
|
||||
#define cell_vm_macro_expand_set_x 44
|
||||
// CONSTANT cell_vm_return 45
|
||||
#define cell_vm_return 45
|
||||
// CONSTANT cell_symbol_dot 46
|
||||
#define cell_symbol_dot 46
|
||||
// CONSTANT cell_symbol_lambda 47
|
||||
#define cell_symbol_lambda 47
|
||||
// CONSTANT cell_symbol_begin 48
|
||||
#define cell_symbol_begin 48
|
||||
// CONSTANT cell_symbol_if 49
|
||||
#define cell_symbol_if 49
|
||||
// CONSTANT cell_symbol_quote 50
|
||||
#define cell_symbol_quote 50
|
||||
// CONSTANT cell_symbol_define 51
|
||||
#define cell_symbol_define 51
|
||||
// CONSTANT cell_symbol_define_macro 52
|
||||
#define cell_symbol_define_macro 52
|
||||
// CONSTANT cell_symbol_quasiquote 53
|
||||
#define cell_symbol_quasiquote 53
|
||||
// CONSTANT cell_symbol_unquote 54
|
||||
#define cell_symbol_unquote 54
|
||||
// CONSTANT cell_symbol_unquote_splicing 55
|
||||
#define cell_symbol_unquote_splicing 55
|
||||
// CONSTANT cell_symbol_syntax 56
|
||||
#define cell_symbol_syntax 56
|
||||
// CONSTANT cell_symbol_quasisyntax 57
|
||||
#define cell_symbol_quasisyntax 57
|
||||
// CONSTANT cell_symbol_unsyntax 58
|
||||
#define cell_symbol_unsyntax 58
|
||||
// CONSTANT cell_symbol_unsyntax_splicing 59
|
||||
#define cell_symbol_unsyntax_splicing 59
|
||||
// CONSTANT cell_symbol_set_x 60
|
||||
#define cell_symbol_set_x 60
|
||||
// CONSTANT cell_symbol_sc_expand 61
|
||||
#define cell_symbol_sc_expand 61
|
||||
// CONSTANT cell_symbol_macro_expand 62
|
||||
#define cell_symbol_macro_expand 62
|
||||
// CONSTANT cell_symbol_portable_macro_expand 63
|
||||
#define cell_symbol_portable_macro_expand 63
|
||||
// CONSTANT cell_symbol_sc_expander_alist 64
|
||||
#define cell_symbol_sc_expander_alist 64
|
||||
// CONSTANT cell_symbol_call_with_values 65
|
||||
#define cell_symbol_call_with_values 65
|
||||
// CONSTANT cell_symbol_call_with_current_continuation 66
|
||||
#define cell_symbol_call_with_current_continuation 66
|
||||
// CONSTANT cell_symbol_boot_module 67
|
||||
#define cell_symbol_boot_module 67
|
||||
// CONSTANT cell_symbol_current_module 68
|
||||
#define cell_symbol_current_module 68
|
||||
// CONSTANT cell_symbol_primitive_load 69
|
||||
#define cell_symbol_primitive_load 69
|
||||
// CONSTANT cell_symbol_read_input_file 70
|
||||
#define cell_symbol_read_input_file 70
|
||||
// CONSTANT cell_symbol_write 71
|
||||
#define cell_symbol_write 71
|
||||
// CONSTANT cell_symbol_display 72
|
||||
#define cell_symbol_display 72
|
||||
// CONSTANT cell_symbol_car 73
|
||||
#define cell_symbol_car 73
|
||||
// CONSTANT cell_symbol_cdr 74
|
||||
#define cell_symbol_cdr 74
|
||||
// CONSTANT cell_symbol_not_a_number 75
|
||||
#define cell_symbol_not_a_number 75
|
||||
// CONSTANT cell_symbol_not_a_pair 76
|
||||
#define cell_symbol_not_a_pair 76
|
||||
// CONSTANT cell_symbol_system_error 77
|
||||
#define cell_symbol_system_error 77
|
||||
// CONSTANT cell_symbol_throw 78
|
||||
#define cell_symbol_throw 78
|
||||
// CONSTANT cell_symbol_unbound_variable 79
|
||||
#define cell_symbol_unbound_variable 79
|
||||
// CONSTANT cell_symbol_wrong_number_of_args 80
|
||||
#define cell_symbol_wrong_number_of_args 80
|
||||
// CONSTANT cell_symbol_wrong_type_arg 81
|
||||
#define cell_symbol_wrong_type_arg 81
|
||||
// CONSTANT cell_symbol_buckets 82
|
||||
#define cell_symbol_buckets 82
|
||||
// CONSTANT cell_symbol_builtin 83
|
||||
#define cell_symbol_builtin 83
|
||||
// CONSTANT cell_symbol_frame 84
|
||||
#define cell_symbol_frame 84
|
||||
// CONSTANT cell_symbol_hashq_table 85
|
||||
#define cell_symbol_hashq_table 85
|
||||
// CONSTANT cell_symbol_module 86
|
||||
#define cell_symbol_module 86
|
||||
// CONSTANT cell_symbol_procedure 87
|
||||
#define cell_symbol_procedure 87
|
||||
// CONSTANT cell_symbol_record_type 88
|
||||
#define cell_symbol_record_type 88
|
||||
// CONSTANT cell_symbol_size 89
|
||||
#define cell_symbol_size 89
|
||||
// CONSTANT cell_symbol_stack 90
|
||||
#define cell_symbol_stack 90
|
||||
// CONSTANT cell_symbol_argv 91
|
||||
#define cell_symbol_argv 91
|
||||
// CONSTANT cell_symbol_mes_prefix 92
|
||||
#define cell_symbol_mes_prefix 92
|
||||
// CONSTANT cell_symbol_mes_version 93
|
||||
#define cell_symbol_mes_version 93
|
||||
// CONSTANT cell_symbol_internal_time_units_per_second 94
|
||||
#define cell_symbol_internal_time_units_per_second 94
|
||||
// CONSTANT cell_symbol_compiler 95
|
||||
#define cell_symbol_compiler 95
|
||||
// CONSTANT cell_symbol_arch 96
|
||||
#define cell_symbol_arch 96
|
||||
// CONSTANT cell_symbol_pmatch_car 97
|
||||
#define cell_symbol_pmatch_car 97
|
||||
// CONSTANT cell_symbol_pmatch_cdr 98
|
||||
#define cell_symbol_pmatch_cdr 98
|
||||
// CONSTANT cell_type_bytes 99
|
||||
#define cell_type_bytes 99
|
||||
// CONSTANT cell_type_char 100
|
||||
#define cell_type_char 100
|
||||
// CONSTANT cell_type_closure 101
|
||||
#define cell_type_closure 101
|
||||
// CONSTANT cell_type_continuation 102
|
||||
#define cell_type_continuation 102
|
||||
// CONSTANT cell_type_function 103
|
||||
#define cell_type_function 103
|
||||
// CONSTANT cell_type_keyword 104
|
||||
#define cell_type_keyword 104
|
||||
// CONSTANT cell_type_macro 105
|
||||
#define cell_type_macro 105
|
||||
// CONSTANT cell_type_number 106
|
||||
#define cell_type_number 106
|
||||
// CONSTANT cell_type_pair 107
|
||||
#define cell_type_pair 107
|
||||
// CONSTANT cell_type_port 108
|
||||
#define cell_type_port 108
|
||||
// CONSTANT cell_type_ref 109
|
||||
#define cell_type_ref 109
|
||||
// CONSTANT cell_type_special 110
|
||||
#define cell_type_special 110
|
||||
// CONSTANT cell_type_string 111
|
||||
#define cell_type_string 111
|
||||
// CONSTANT cell_type_struct 112
|
||||
#define cell_type_struct 112
|
||||
// CONSTANT cell_type_symbol 113
|
||||
#define cell_type_symbol 113
|
||||
// CONSTANT cell_type_values 114
|
||||
#define cell_type_values 114
|
||||
// CONSTANT cell_type_variable 115
|
||||
#define cell_type_variable 115
|
||||
// CONSTANT cell_type_vector 116
|
||||
#define cell_type_vector 116
|
||||
// CONSTANT cell_type_broken_heart 117
|
||||
#define cell_type_broken_heart 117
|
||||
// CONSTANT cell_symbol_test 118
|
||||
#define cell_symbol_test 118
|
||||
// src/module.mes
|
||||
/* src/module.mes */
|
||||
SCM make_module_type ();
|
||||
SCM module_printer (SCM module);
|
||||
SCM module_variable (SCM module, SCM name);
|
||||
SCM module_ref (SCM module, SCM name);
|
||||
SCM module_define_x (SCM module, SCM name, SCM value);
|
||||
// src/posix.mes
|
||||
/* src/posix.mes */
|
||||
SCM peek_byte ();
|
||||
SCM read_byte ();
|
||||
SCM unread_byte (SCM i);
|
||||
|
|
@ -376,7 +140,7 @@ SCM getcwd_ ();
|
|||
SCM dup_ (SCM port);
|
||||
SCM dup2_ (SCM old, SCM new);
|
||||
SCM delete_file (SCM file_name);
|
||||
// src/reader.mes
|
||||
/* src/reader.mes */
|
||||
SCM read_input_file_env_ (SCM e, SCM a);
|
||||
SCM read_input_file_env (SCM a);
|
||||
SCM read_env (SCM a);
|
||||
|
|
@ -386,7 +150,7 @@ SCM reader_read_binary ();
|
|||
SCM reader_read_octal ();
|
||||
SCM reader_read_hex ();
|
||||
SCM reader_read_string ();
|
||||
// src/strings.mes
|
||||
/* src/strings.mes */
|
||||
SCM string_equal_p (SCM a, SCM b);
|
||||
SCM symbol_to_string (SCM symbol);
|
||||
SCM symbol_to_keyword (SCM symbol);
|
||||
|
|
@ -399,12 +163,12 @@ SCM read_string (SCM port);
|
|||
SCM string_append (SCM x);
|
||||
SCM string_length (SCM string);
|
||||
SCM string_ref (SCM str, SCM k);
|
||||
// src/struct.mes
|
||||
/* src/struct.mes */
|
||||
SCM make_struct (SCM type, SCM fields, SCM printer);
|
||||
SCM struct_length (SCM x);
|
||||
SCM struct_ref (SCM x, SCM i);
|
||||
SCM struct_set_x (SCM x, SCM i, SCM e);
|
||||
// src/vector.mes
|
||||
/* src/vector.mes */
|
||||
SCM make_vector_ (SCM n);
|
||||
SCM vector_length (SCM x);
|
||||
SCM vector_ref (SCM x, SCM i);
|
||||
|
|
|
|||
|
|
@ -269,8 +269,8 @@
|
|||
// CONSTANT cell_type_broken_heart 117
|
||||
#define cell_type_broken_heart 117
|
||||
|
||||
// CONSTANT cell_test 118
|
||||
#define cell_test 118
|
||||
// CONSTANT cell_symbol_test 118
|
||||
#define cell_symbol_test 118
|
||||
|
||||
/* Cell types */
|
||||
|
||||
|
|
|
|||
|
|
@ -32,6 +32,20 @@ struct scm
|
|||
SCM cdr;
|
||||
};
|
||||
|
||||
#if __MESC__
|
||||
typedef long function0_t;
|
||||
typedef long function1_t;
|
||||
typedef long function2_t;
|
||||
typedef long function3_t;
|
||||
typedef long functionn_t;
|
||||
#else // !__MESC__
|
||||
typedef SCM (*function0_t) (void);
|
||||
typedef SCM (*function1_t) (SCM);
|
||||
typedef SCM (*function2_t) (SCM, SCM);
|
||||
typedef SCM (*function3_t) (SCM, SCM, SCM);
|
||||
typedef SCM (*functionn_t) (SCM);
|
||||
#endif // !__MESC__
|
||||
|
||||
// mes
|
||||
extern int g_debug;
|
||||
extern char *g_buf;
|
||||
|
|
@ -70,15 +84,21 @@ extern struct scm *g_news;
|
|||
SCM alloc (long n);
|
||||
SCM apply (SCM f, SCM x, SCM a);
|
||||
SCM apply_builtin (SCM fn, SCM x);
|
||||
SCM builtin_name (SCM builtin);
|
||||
#if __MESC__
|
||||
long builtin_function (SCM builtin);
|
||||
#else
|
||||
SCM (*builtin_function (SCM builtin)) (SCM);
|
||||
#endif
|
||||
SCM cstring_to_list (char const *s);
|
||||
SCM cstring_to_symbol (char const *s);
|
||||
SCM display_ (SCM x);
|
||||
SCM fdisplay_ (SCM, int, int);
|
||||
SCM gc_init ();
|
||||
SCM gc_peek_frame ();
|
||||
SCM gc_pop_frame ();
|
||||
SCM gc_push_frame ();
|
||||
SCM init_time (SCM a);
|
||||
SCM make_builtin_type ();
|
||||
SCM make_bytes (char const *s, size_t length);
|
||||
SCM make_cell__ (long type, SCM car, SCM cdr);
|
||||
SCM make_hash_table_ (long size);
|
||||
|
|
@ -86,8 +106,7 @@ SCM make_hashq_type ();
|
|||
SCM make_initial_module (SCM a);
|
||||
SCM make_string (char const *s, size_t length);
|
||||
SCM make_vector__ (long k);
|
||||
SCM read_input_file_env (SCM);
|
||||
SCM string_equal_p (SCM a, SCM b);
|
||||
SCM mes_builtins (SCM a);
|
||||
SCM struct_ref_ (SCM x, long i);
|
||||
SCM struct_set_x_ (SCM x, long i, SCM e);
|
||||
SCM vector_ref_ (SCM x, long i);
|
||||
|
|
|
|||
|
|
@ -46,6 +46,7 @@ CFLAGS:= \
|
|||
-Wno-int-conversion
|
||||
|
||||
MES_SOURCES = \
|
||||
src/builtins.c \
|
||||
src/gc.c \
|
||||
src/hash.c \
|
||||
src/lib.c \
|
||||
|
|
|
|||
|
|
@ -0,0 +1,272 @@
|
|||
/* -*-comment-start: "//";comment-end:""-*-
|
||||
* GNU Mes --- Maxwell Equations of Software
|
||||
* Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
*
|
||||
* This file is part of GNU Mes.
|
||||
*
|
||||
* GNU Mes is free software; you can redistribute it and/or modify it
|
||||
* under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 3 of the License, or (at
|
||||
* your option) any later version.
|
||||
*
|
||||
* GNU Mes is distributed in the hope that it will be useful, but
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
#include "mes/lib.h"
|
||||
#include "mes/mes.h"
|
||||
|
||||
SCM
|
||||
make_builtin_type () ///(internal))
|
||||
{
|
||||
SCM record_type = cell_symbol_record_type;
|
||||
SCM fields = cell_nil;
|
||||
fields = cons (cstring_to_symbol ("address"), fields);
|
||||
fields = cons (cstring_to_symbol ("arity"), fields);
|
||||
fields = cons (cstring_to_symbol ("name"), fields);
|
||||
fields = cons (fields, cell_nil);
|
||||
fields = cons (cell_symbol_builtin, fields);
|
||||
return make_struct (record_type, fields, cell_unspecified);
|
||||
}
|
||||
|
||||
SCM
|
||||
make_builtin (SCM builtin_type, SCM name, SCM arity, SCM function)
|
||||
{
|
||||
SCM values = cell_nil;
|
||||
values = cons (function, values);
|
||||
values = cons (arity, values);
|
||||
values = cons (name, values);
|
||||
values = cons (cell_symbol_builtin, values);
|
||||
return make_struct (builtin_type, values, cstring_to_symbol ("builtin-printer"));
|
||||
}
|
||||
|
||||
SCM
|
||||
builtin_name (SCM builtin)
|
||||
{
|
||||
return struct_ref_ (builtin, 3);
|
||||
}
|
||||
|
||||
SCM
|
||||
builtin_arity (SCM builtin)
|
||||
{
|
||||
return struct_ref_ (builtin, 4);
|
||||
}
|
||||
|
||||
#if __MESC__
|
||||
long
|
||||
builtin_function (SCM builtin)
|
||||
{
|
||||
return VALUE (struct_ref_ (builtin, 5));
|
||||
}
|
||||
#else
|
||||
SCM (*builtin_function (SCM builtin)) (SCM)
|
||||
{
|
||||
return (function1_t) VALUE (struct_ref_ (builtin, 5));
|
||||
}
|
||||
#endif
|
||||
|
||||
SCM
|
||||
builtin_p (SCM x)
|
||||
{
|
||||
return (TYPE (x) == TSTRUCT && struct_ref_ (x, 2) == cell_symbol_builtin) ? cell_t : cell_f;
|
||||
}
|
||||
|
||||
SCM
|
||||
builtin_printer (SCM builtin)
|
||||
{
|
||||
fdputs ("#<procedure ", __stdout);
|
||||
display_ (builtin_name (builtin));
|
||||
fdputc (' ', __stdout);
|
||||
int arity = VALUE (builtin_arity (builtin));
|
||||
if (arity == -1)
|
||||
fdputc ('_', __stdout);
|
||||
else
|
||||
{
|
||||
fdputc ('(', __stdout);
|
||||
for (int i = 0; i < arity; i++)
|
||||
{
|
||||
if (i)
|
||||
fdputc (' ', __stdout);
|
||||
fdputc ('_', __stdout);
|
||||
}
|
||||
}
|
||||
fdputc ('>', __stdout);
|
||||
}
|
||||
|
||||
SCM
|
||||
init_builtin (SCM builtin_type, char const *name, int arity, SCM (*function) (SCM), SCM a)
|
||||
{
|
||||
SCM s = cstring_to_symbol (name);
|
||||
return acons (s,
|
||||
make_builtin (builtin_type, symbol_to_string (s), MAKE_NUMBER (arity),
|
||||
MAKE_NUMBER (function)), a);
|
||||
}
|
||||
|
||||
SCM
|
||||
mes_builtins (SCM a) ///((internal))
|
||||
{
|
||||
// TODO minimal: cons, car, cdr, list, null_p, eq_p minus, plus
|
||||
// display_, display_error_, getenv
|
||||
|
||||
SCM builtin_type = make_builtin_type ();
|
||||
|
||||
/* src/builtins.c */
|
||||
a = init_builtin (builtin_type, "make-builtin-type", 0, (function1_t) & make_builtin_type, a);
|
||||
a = init_builtin (builtin_type, "make-builtin", 4, (function1_t) & make_builtin, a);
|
||||
a = init_builtin (builtin_type, "builtin-name", 1, (function1_t) & builtin_name, a);
|
||||
a = init_builtin (builtin_type, "builtin-arity", 1, (function1_t) & builtin_arity, a);
|
||||
a = init_builtin (builtin_type, "builtin?", 1, (function1_t) & builtin_p, a);
|
||||
a = init_builtin (builtin_type, "builtin-printer", 1, (function1_t) & builtin_printer, a);
|
||||
/* src/gc.c */
|
||||
a = init_builtin (builtin_type, "gc-check", 0, (function1_t) & gc_check, a);
|
||||
a = init_builtin (builtin_type, "gc", 0, (function1_t) & gc, a);
|
||||
/* src/hash.c */
|
||||
a = init_builtin (builtin_type, "hashq", 2, (function1_t) & hashq, a);
|
||||
a = init_builtin (builtin_type, "hash", 2, (function1_t) & hash, a);
|
||||
a = init_builtin (builtin_type, "hashq-get-handle", 3, (function1_t) & hashq_get_handle, a);
|
||||
a = init_builtin (builtin_type, "hashq-ref", 3, (function1_t) & hashq_ref, a);
|
||||
a = init_builtin (builtin_type, "hash-ref", 3, (function1_t) & hash_ref, a);
|
||||
a = init_builtin (builtin_type, "hashq-set!", 3, (function1_t) & hashq_set_x, a);
|
||||
a = init_builtin (builtin_type, "hash-set!", 3, (function1_t) & hash_set_x, a);
|
||||
a = init_builtin (builtin_type, "hash-table-printer", 1, (function1_t) & hash_table_printer, a);
|
||||
a = init_builtin (builtin_type, "make-hash-table", 1, (function1_t) & make_hash_table, a);
|
||||
/* src/lib.c */
|
||||
a = init_builtin (builtin_type, "core:display", 1, (function1_t) & display_, a);
|
||||
a = init_builtin (builtin_type, "core:display-error", 1, (function1_t) & display_error_, a);
|
||||
a = init_builtin (builtin_type, "core:display-port", 2, (function1_t) & display_port_, a);
|
||||
a = init_builtin (builtin_type, "core:write", 1, (function1_t) & write_, a);
|
||||
a = init_builtin (builtin_type, "core:write-error", 1, (function1_t) & write_error_, a);
|
||||
a = init_builtin (builtin_type, "core:write-port", 2, (function1_t) & write_port_, a);
|
||||
a = init_builtin (builtin_type, "exit", 1, (function1_t) & exit_, a);
|
||||
a = init_builtin (builtin_type, "frame-printer", 1, (function1_t) & frame_printer, a);
|
||||
a = init_builtin (builtin_type, "make-stack", -1, (function1_t) & make_stack, a);
|
||||
a = init_builtin (builtin_type, "stack-length", 1, (function1_t) & stack_length, a);
|
||||
a = init_builtin (builtin_type, "stack-ref", 2, (function1_t) & stack_ref, a);
|
||||
a = init_builtin (builtin_type, "xassq", 2, (function1_t) & xassq, a);
|
||||
a = init_builtin (builtin_type, "memq", 2, (function1_t) & memq, a);
|
||||
a = init_builtin (builtin_type, "equal2?", 2, (function1_t) & equal2_p, a);
|
||||
a = init_builtin (builtin_type, "last-pair", 1, (function1_t) & last_pair, a);
|
||||
a = init_builtin (builtin_type, "pair?", 1, (function1_t) & pair_p, a);
|
||||
/* src/math.c */
|
||||
a = init_builtin (builtin_type, ">", -1, (function1_t) & greater_p, a);
|
||||
a = init_builtin (builtin_type, "<", -1, (function1_t) & less_p, a);
|
||||
a = init_builtin (builtin_type, "=", -1, (function1_t) & is_p, a);
|
||||
a = init_builtin (builtin_type, "-", -1, (function1_t) & minus, a);
|
||||
a = init_builtin (builtin_type, "+", -1, (function1_t) & plus, a);
|
||||
a = init_builtin (builtin_type, "/", -1, (function1_t) & divide, a);
|
||||
a = init_builtin (builtin_type, "modulo", 2, (function1_t) & modulo, a);
|
||||
a = init_builtin (builtin_type, "*", -1, (function1_t) & multiply, a);
|
||||
a = init_builtin (builtin_type, "logand", -1, (function1_t) & logand, a);
|
||||
a = init_builtin (builtin_type, "logior", -1, (function1_t) & logior, a);
|
||||
a = init_builtin (builtin_type, "lognot", 1, (function1_t) & lognot, a);
|
||||
a = init_builtin (builtin_type, "logxor", -1, (function1_t) & logxor, a);
|
||||
a = init_builtin (builtin_type, "ash", 2, (function1_t) & ash, a);
|
||||
/* src/mes.c */
|
||||
a = init_builtin (builtin_type, "core:make-cell", 3, (function1_t) & make_cell_, a);
|
||||
a = init_builtin (builtin_type, "core:type", 1, (function1_t) & type_, a);
|
||||
a = init_builtin (builtin_type, "core:car", 1, (function1_t) & car_, a);
|
||||
a = init_builtin (builtin_type, "core:cdr", 1, (function1_t) & cdr_, a);
|
||||
a = init_builtin (builtin_type, "cons", 2, (function1_t) & cons, a);
|
||||
a = init_builtin (builtin_type, "car", 1, (function1_t) & car, a);
|
||||
a = init_builtin (builtin_type, "cdr", 1, (function1_t) & cdr, a);
|
||||
a = init_builtin (builtin_type, "list", -1, (function1_t) & list, a);
|
||||
a = init_builtin (builtin_type, "null?", 1, (function1_t) & null_p, a);
|
||||
a = init_builtin (builtin_type, "eq?", 2, (function1_t) & eq_p, a);
|
||||
a = init_builtin (builtin_type, "values", -1, (function1_t) & values, a);
|
||||
a = init_builtin (builtin_type, "acons", 3, (function1_t) & acons, a);
|
||||
a = init_builtin (builtin_type, "length", 1, (function1_t) & length, a);
|
||||
a = init_builtin (builtin_type, "error", 2, (function1_t) & error, a);
|
||||
a = init_builtin (builtin_type, "append2", 2, (function1_t) & append2, a);
|
||||
a = init_builtin (builtin_type, "append-reverse", 2, (function1_t) & append_reverse, a);
|
||||
a = init_builtin (builtin_type, "core:reverse!", 2, (function1_t) & reverse_x_, a);
|
||||
a = init_builtin (builtin_type, "pairlis", 3, (function1_t) & pairlis, a);
|
||||
a = init_builtin (builtin_type, "assq", 2, (function1_t) & assq, a);
|
||||
a = init_builtin (builtin_type, "assoc", 2, (function1_t) & assoc, a);
|
||||
a = init_builtin (builtin_type, "set-car!", 2, (function1_t) & set_car_x, a);
|
||||
a = init_builtin (builtin_type, "set-cdr!", 2, (function1_t) & set_cdr_x, a);
|
||||
a = init_builtin (builtin_type, "set-env!", 3, (function1_t) & set_env_x, a);
|
||||
a = init_builtin (builtin_type, "macro-get-handle", 1, (function1_t) & macro_get_handle, a);
|
||||
a = init_builtin (builtin_type, "add-formals", 2, (function1_t) & add_formals, a);
|
||||
a = init_builtin (builtin_type, "eval-apply", 0, (function1_t) & eval_apply, a);
|
||||
/* src/module.c */
|
||||
a = init_builtin (builtin_type, "make-module-type", 0, (function1_t) & make_module_type, a);
|
||||
a = init_builtin (builtin_type, "module-printer", 1, (function1_t) & module_printer, a);
|
||||
a = init_builtin (builtin_type, "module-variable", 2, (function1_t) & module_variable, a);
|
||||
a = init_builtin (builtin_type, "module-ref", 2, (function1_t) & module_ref, a);
|
||||
a = init_builtin (builtin_type, "module-define!", 3, (function1_t) & module_define_x, a);
|
||||
/* src/posix.c */
|
||||
a = init_builtin (builtin_type, "peek-byte", 0, (function1_t) & peek_byte, a);
|
||||
a = init_builtin (builtin_type, "read-byte", 0, (function1_t) & read_byte, a);
|
||||
a = init_builtin (builtin_type, "unread-byte", 1, (function1_t) & unread_byte, a);
|
||||
a = init_builtin (builtin_type, "peek-char", 0, (function1_t) & peek_char, a);
|
||||
a = init_builtin (builtin_type, "read-char", -1, (function1_t) & read_char, a);
|
||||
a = init_builtin (builtin_type, "unread-char", 1, (function1_t) & unread_char, a);
|
||||
a = init_builtin (builtin_type, "write-char", -1, (function1_t) & write_char, a);
|
||||
a = init_builtin (builtin_type, "write-byte", -1, (function1_t) & write_byte, a);
|
||||
a = init_builtin (builtin_type, "getenv", 1, (function1_t) & getenv_, a);
|
||||
a = init_builtin (builtin_type, "setenv", 2, (function1_t) & setenv_, a);
|
||||
a = init_builtin (builtin_type, "access?", 2, (function1_t) & access_p, a);
|
||||
a = init_builtin (builtin_type, "current-input-port", 0, (function1_t) & current_input_port, a);
|
||||
a = init_builtin (builtin_type, "open-input-file", 1, (function1_t) & open_input_file, a);
|
||||
a = init_builtin (builtin_type, "open-input-string", 1, (function1_t) & open_input_string, a);
|
||||
a = init_builtin (builtin_type, "set-current-input-port", 1, (function1_t) & set_current_input_port, a);
|
||||
a = init_builtin (builtin_type, "current-output-port", 0, (function1_t) & current_output_port, a);
|
||||
a = init_builtin (builtin_type, "current-error-port", 0, (function1_t) & current_error_port, a);
|
||||
a = init_builtin (builtin_type, "open-output-file", -1, (function1_t) & open_output_file, a);
|
||||
a = init_builtin (builtin_type, "set-current-output-port", 1, (function1_t) & set_current_output_port, a);
|
||||
a = init_builtin (builtin_type, "set-current-error-port", 1, (function1_t) & set_current_error_port, a);
|
||||
a = init_builtin (builtin_type, "chmod", 2, (function1_t) & chmod_, a);
|
||||
a = init_builtin (builtin_type, "isatty?", 1, (function1_t) & isatty_p, a);
|
||||
a = init_builtin (builtin_type, "primitive-fork", 0, (function1_t) & primitive_fork, a);
|
||||
a = init_builtin (builtin_type, "execl", 2, (function1_t) & execl_, a);
|
||||
a = init_builtin (builtin_type, "core:waitpid", 2, (function1_t) & waitpid_, a);
|
||||
a = init_builtin (builtin_type, "current-time", 0, (function1_t) & current_time, a);
|
||||
a = init_builtin (builtin_type, "gettimeofday", 0, (function1_t) & gettimeofday_, a);
|
||||
a = init_builtin (builtin_type, "get-internal-run-time", 0, (function1_t) & get_internal_run_time, a);
|
||||
a = init_builtin (builtin_type, "getcwd", 0, (function1_t) & getcwd_, a);
|
||||
a = init_builtin (builtin_type, "dup", 1, (function1_t) & dup_, a);
|
||||
a = init_builtin (builtin_type, "dup2", 2, (function1_t) & dup2_, a);
|
||||
a = init_builtin (builtin_type, "delete-file", 1, (function1_t) & delete_file, a);
|
||||
/* src/reader.c */
|
||||
a = init_builtin (builtin_type, "core:read-input-file-env", 2, (function1_t) & read_input_file_env_, a);
|
||||
a = init_builtin (builtin_type, "read-input-file-env", 1, (function1_t) & read_input_file_env, a);
|
||||
a = init_builtin (builtin_type, "read-env", 1, (function1_t) & read_env, a);
|
||||
a = init_builtin (builtin_type, "reader-read-sexp", 3, (function1_t) & reader_read_sexp, a);
|
||||
a = init_builtin (builtin_type, "reader-read-character", 0, (function1_t) & reader_read_character, a);
|
||||
a = init_builtin (builtin_type, "reader-read-binary", 0, (function1_t) & reader_read_binary, a);
|
||||
a = init_builtin (builtin_type, "reader-read-octal", 0, (function1_t) & reader_read_octal, a);
|
||||
a = init_builtin (builtin_type, "reader-read-hex", 0, (function1_t) & reader_read_hex, a);
|
||||
a = init_builtin (builtin_type, "reader-read-string", 0, (function1_t) & reader_read_string, a);
|
||||
/* src/string.c */
|
||||
a = init_builtin (builtin_type, "string=?", 2, (function1_t) & string_equal_p, a);
|
||||
a = init_builtin (builtin_type, "symbol->string", 1, (function1_t) & symbol_to_string, a);
|
||||
a = init_builtin (builtin_type, "symbol->keyword", 1, (function1_t) & symbol_to_keyword, a);
|
||||
a = init_builtin (builtin_type, "keyword->string", 1, (function1_t) & keyword_to_string, a);
|
||||
a = init_builtin (builtin_type, "string->symbol", 1, (function1_t) & string_to_symbol, a);
|
||||
a = init_builtin (builtin_type, "make-symbol", 1, (function1_t) & make_symbol, a);
|
||||
a = init_builtin (builtin_type, "string->list", 1, (function1_t) & string_to_list, a);
|
||||
a = init_builtin (builtin_type, "list->string", 1, (function1_t) & list_to_string, a);
|
||||
a = init_builtin (builtin_type, "read-string", -1, (function1_t) & read_string, a);
|
||||
a = init_builtin (builtin_type, "string-append", -1, (function1_t) & string_append, a);
|
||||
a = init_builtin (builtin_type, "string-length", 1, (function1_t) & string_length, a);
|
||||
a = init_builtin (builtin_type, "string-ref", 2, (function1_t) & string_ref, a);
|
||||
/* src/struct.c */
|
||||
a = init_builtin (builtin_type, "make-struct", 3, (function1_t) & make_struct, a);
|
||||
a = init_builtin (builtin_type, "struct-length", 1, (function1_t) & struct_length, a);
|
||||
a = init_builtin (builtin_type, "struct-ref", 2, (function1_t) & struct_ref, a);
|
||||
a = init_builtin (builtin_type, "struct-set!", 3, (function1_t) & struct_set_x, a);
|
||||
/* src/vector.c */
|
||||
a = init_builtin (builtin_type, "core:make-vector", 1, (function1_t) & make_vector_, a);
|
||||
a = init_builtin (builtin_type, "vector-length", 1, (function1_t) & vector_length, a);
|
||||
a = init_builtin (builtin_type, "vector-ref", 2, (function1_t) & vector_ref, a);
|
||||
a = init_builtin (builtin_type, "vector-entry", 1, (function1_t) & vector_entry, a);
|
||||
a = init_builtin (builtin_type, "vector-set!", 3, (function1_t) & vector_set_x, a);
|
||||
a = init_builtin (builtin_type, "list->vector", 1, (function1_t) & list_to_vector, a);
|
||||
a = init_builtin (builtin_type, "vector->list", 1, (function1_t) & vector_to_list, a);
|
||||
return a;
|
||||
}
|
||||
264
src/mes.c
264
src/mes.c
|
|
@ -48,20 +48,6 @@ SCM m0;
|
|||
SCM g_macros;
|
||||
SCM g_ports;
|
||||
|
||||
#if __MESC__
|
||||
typedef long function0_t;
|
||||
typedef long function1_t;
|
||||
typedef long function2_t;
|
||||
typedef long function3_t;
|
||||
typedef long functionn_t;
|
||||
#else // !__MESC__
|
||||
typedef SCM (*function0_t) (void);
|
||||
typedef SCM (*function1_t) (SCM);
|
||||
typedef SCM (*function2_t) (SCM, SCM);
|
||||
typedef SCM (*function3_t) (SCM, SCM, SCM);
|
||||
typedef SCM (*functionn_t) (SCM);
|
||||
#endif // !__MESC__
|
||||
|
||||
SCM
|
||||
alloc (long n)
|
||||
{
|
||||
|
|
@ -1441,92 +1427,6 @@ mes_environment (int argc, char *argv[])
|
|||
return mes_g_stack (a);
|
||||
}
|
||||
|
||||
SCM
|
||||
init_builtin (SCM builtin_type, char const *name, int arity, SCM (*function) (SCM), SCM a)
|
||||
{
|
||||
SCM s = cstring_to_symbol (name);
|
||||
return acons (s,
|
||||
make_builtin (builtin_type, symbol_to_string (s), MAKE_NUMBER (arity),
|
||||
MAKE_NUMBER (function)), a);
|
||||
}
|
||||
|
||||
SCM
|
||||
make_builtin_type () ///(internal))
|
||||
{
|
||||
SCM record_type = cell_symbol_record_type;
|
||||
SCM fields = cell_nil;
|
||||
fields = cons (cstring_to_symbol ("address"), fields);
|
||||
fields = cons (cstring_to_symbol ("arity"), fields);
|
||||
fields = cons (cstring_to_symbol ("name"), fields);
|
||||
fields = cons (fields, cell_nil);
|
||||
fields = cons (cell_symbol_builtin, fields);
|
||||
return make_struct (record_type, fields, cell_unspecified);
|
||||
}
|
||||
|
||||
SCM
|
||||
make_builtin (SCM builtin_type, SCM name, SCM arity, SCM function)
|
||||
{
|
||||
SCM values = cell_nil;
|
||||
values = cons (function, values);
|
||||
values = cons (arity, values);
|
||||
values = cons (name, values);
|
||||
values = cons (cell_symbol_builtin, values);
|
||||
return make_struct (builtin_type, values, cstring_to_symbol ("builtin-printer"));
|
||||
}
|
||||
|
||||
SCM
|
||||
builtin_name (SCM builtin)
|
||||
{
|
||||
return struct_ref_ (builtin, 3);
|
||||
}
|
||||
|
||||
SCM
|
||||
builtin_arity (SCM builtin)
|
||||
{
|
||||
return struct_ref_ (builtin, 4);
|
||||
}
|
||||
|
||||
#if __MESC__
|
||||
long
|
||||
builtin_function (SCM builtin)
|
||||
{
|
||||
return VALUE (struct_ref_ (builtin, 5));
|
||||
}
|
||||
#else
|
||||
SCM (*builtin_function (SCM builtin)) (SCM)
|
||||
{
|
||||
return (function1_t) VALUE (struct_ref_ (builtin, 5));
|
||||
}
|
||||
#endif
|
||||
|
||||
SCM
|
||||
builtin_p (SCM x)
|
||||
{
|
||||
return (TYPE (x) == TSTRUCT && struct_ref_ (x, 2) == cell_symbol_builtin) ? cell_t : cell_f;
|
||||
}
|
||||
|
||||
SCM
|
||||
builtin_printer (SCM builtin)
|
||||
{
|
||||
fdputs ("#<procedure ", __stdout);
|
||||
display_ (builtin_name (builtin));
|
||||
fdputc (' ', __stdout);
|
||||
int arity = VALUE (builtin_arity (builtin));
|
||||
if (arity == -1)
|
||||
fdputc ('_', __stdout);
|
||||
else
|
||||
{
|
||||
fdputc ('(', __stdout);
|
||||
for (int i = 0; i < arity; i++)
|
||||
{
|
||||
if (i)
|
||||
fdputc (' ', __stdout);
|
||||
fdputc ('_', __stdout);
|
||||
}
|
||||
}
|
||||
fdputc ('>', __stdout);
|
||||
}
|
||||
|
||||
SCM
|
||||
apply_builtin (SCM fn, SCM x) ///((internal))
|
||||
{
|
||||
|
|
@ -1582,170 +1482,6 @@ apply_builtin (SCM fn, SCM x) ///((internal))
|
|||
return cell_unspecified;
|
||||
}
|
||||
|
||||
SCM
|
||||
mes_builtins (SCM a) ///((internal))
|
||||
{
|
||||
// TODO minimal: cons, car, cdr, list, null_p, eq_p minus, plus
|
||||
// display_, display_error_, getenv
|
||||
|
||||
SCM builtin_type = make_builtin_type ();
|
||||
|
||||
// src/gc.mes
|
||||
a = init_builtin (builtin_type, "gc-check", 0, (function1_t) & gc_check, a);
|
||||
a = init_builtin (builtin_type, "gc", 0, (function1_t) & gc, a);
|
||||
// src/hash.mes
|
||||
a = init_builtin (builtin_type, "hashq", 2, (function1_t) & hashq, a);
|
||||
a = init_builtin (builtin_type, "hash", 2, (function1_t) & hash, a);
|
||||
a = init_builtin (builtin_type, "hashq-get-handle", 3, (function1_t) & hashq_get_handle, a);
|
||||
a = init_builtin (builtin_type, "hashq-ref", 3, (function1_t) & hashq_ref, a);
|
||||
a = init_builtin (builtin_type, "hash-ref", 3, (function1_t) & hash_ref, a);
|
||||
a = init_builtin (builtin_type, "hashq-set!", 3, (function1_t) & hashq_set_x, a);
|
||||
a = init_builtin (builtin_type, "hash-set!", 3, (function1_t) & hash_set_x, a);
|
||||
a = init_builtin (builtin_type, "hash-table-printer", 1, (function1_t) & hash_table_printer, a);
|
||||
a = init_builtin (builtin_type, "make-hash-table", 1, (function1_t) & make_hash_table, a);
|
||||
// src/lib.mes
|
||||
a = init_builtin (builtin_type, "core:display", 1, (function1_t) & display_, a);
|
||||
a = init_builtin (builtin_type, "core:display-error", 1, (function1_t) & display_error_, a);
|
||||
a = init_builtin (builtin_type, "core:display-port", 2, (function1_t) & display_port_, a);
|
||||
a = init_builtin (builtin_type, "core:write", 1, (function1_t) & write_, a);
|
||||
a = init_builtin (builtin_type, "core:write-error", 1, (function1_t) & write_error_, a);
|
||||
a = init_builtin (builtin_type, "core:write-port", 2, (function1_t) & write_port_, a);
|
||||
a = init_builtin (builtin_type, "exit", 1, (function1_t) & exit_, a);
|
||||
a = init_builtin (builtin_type, "frame-printer", 1, (function1_t) & frame_printer, a);
|
||||
a = init_builtin (builtin_type, "make-stack", -1, (function1_t) & make_stack, a);
|
||||
a = init_builtin (builtin_type, "stack-length", 1, (function1_t) & stack_length, a);
|
||||
a = init_builtin (builtin_type, "stack-ref", 2, (function1_t) & stack_ref, a);
|
||||
a = init_builtin (builtin_type, "xassq", 2, (function1_t) & xassq, a);
|
||||
a = init_builtin (builtin_type, "memq", 2, (function1_t) & memq, a);
|
||||
a = init_builtin (builtin_type, "equal2?", 2, (function1_t) & equal2_p, a);
|
||||
a = init_builtin (builtin_type, "last-pair", 1, (function1_t) & last_pair, a);
|
||||
a = init_builtin (builtin_type, "pair?", 1, (function1_t) & pair_p, a);
|
||||
// src/math.mes
|
||||
a = init_builtin (builtin_type, ">", -1, (function1_t) & greater_p, a);
|
||||
a = init_builtin (builtin_type, "<", -1, (function1_t) & less_p, a);
|
||||
a = init_builtin (builtin_type, "=", -1, (function1_t) & is_p, a);
|
||||
a = init_builtin (builtin_type, "-", -1, (function1_t) & minus, a);
|
||||
a = init_builtin (builtin_type, "+", -1, (function1_t) & plus, a);
|
||||
a = init_builtin (builtin_type, "/", -1, (function1_t) & divide, a);
|
||||
a = init_builtin (builtin_type, "modulo", 2, (function1_t) & modulo, a);
|
||||
a = init_builtin (builtin_type, "*", -1, (function1_t) & multiply, a);
|
||||
a = init_builtin (builtin_type, "logand", -1, (function1_t) & logand, a);
|
||||
a = init_builtin (builtin_type, "logior", -1, (function1_t) & logior, a);
|
||||
a = init_builtin (builtin_type, "lognot", 1, (function1_t) & lognot, a);
|
||||
a = init_builtin (builtin_type, "logxor", -1, (function1_t) & logxor, a);
|
||||
a = init_builtin (builtin_type, "ash", 2, (function1_t) & ash, a);
|
||||
// src/mes.mes
|
||||
a = init_builtin (builtin_type, "core:make-cell", 3, (function1_t) & make_cell_, a);
|
||||
a = init_builtin (builtin_type, "core:type", 1, (function1_t) & type_, a);
|
||||
a = init_builtin (builtin_type, "core:car", 1, (function1_t) & car_, a);
|
||||
a = init_builtin (builtin_type, "core:cdr", 1, (function1_t) & cdr_, a);
|
||||
a = init_builtin (builtin_type, "cons", 2, (function1_t) & cons, a);
|
||||
a = init_builtin (builtin_type, "car", 1, (function1_t) & car, a);
|
||||
a = init_builtin (builtin_type, "cdr", 1, (function1_t) & cdr, a);
|
||||
a = init_builtin (builtin_type, "list", -1, (function1_t) & list, a);
|
||||
a = init_builtin (builtin_type, "null?", 1, (function1_t) & null_p, a);
|
||||
a = init_builtin (builtin_type, "eq?", 2, (function1_t) & eq_p, a);
|
||||
a = init_builtin (builtin_type, "values", -1, (function1_t) & values, a);
|
||||
a = init_builtin (builtin_type, "acons", 3, (function1_t) & acons, a);
|
||||
a = init_builtin (builtin_type, "length", 1, (function1_t) & length, a);
|
||||
a = init_builtin (builtin_type, "error", 2, (function1_t) & error, a);
|
||||
a = init_builtin (builtin_type, "append2", 2, (function1_t) & append2, a);
|
||||
a = init_builtin (builtin_type, "append-reverse", 2, (function1_t) & append_reverse, a);
|
||||
a = init_builtin (builtin_type, "core:reverse!", 2, (function1_t) & reverse_x_, a);
|
||||
a = init_builtin (builtin_type, "pairlis", 3, (function1_t) & pairlis, a);
|
||||
a = init_builtin (builtin_type, "assq", 2, (function1_t) & assq, a);
|
||||
a = init_builtin (builtin_type, "assoc", 2, (function1_t) & assoc, a);
|
||||
a = init_builtin (builtin_type, "set-car!", 2, (function1_t) & set_car_x, a);
|
||||
a = init_builtin (builtin_type, "set-cdr!", 2, (function1_t) & set_cdr_x, a);
|
||||
a = init_builtin (builtin_type, "set-env!", 3, (function1_t) & set_env_x, a);
|
||||
a = init_builtin (builtin_type, "macro-get-handle", 1, (function1_t) & macro_get_handle, a);
|
||||
a = init_builtin (builtin_type, "add-formals", 2, (function1_t) & add_formals, a);
|
||||
a = init_builtin (builtin_type, "eval-apply", 0, (function1_t) & eval_apply, a);
|
||||
a = init_builtin (builtin_type, "make-builtin-type", 0, (function1_t) & make_builtin_type, a);
|
||||
a = init_builtin (builtin_type, "make-builtin", 4, (function1_t) & make_builtin, a);
|
||||
a = init_builtin (builtin_type, "builtin-name", 1, (function1_t) & builtin_name, a);
|
||||
a = init_builtin (builtin_type, "builtin-arity", 1, (function1_t) & builtin_arity, a);
|
||||
a = init_builtin (builtin_type, "builtin?", 1, (function1_t) & builtin_p, a);
|
||||
a = init_builtin (builtin_type, "builtin-printer", 1, (function1_t) & builtin_printer, a);
|
||||
// src/module.mes
|
||||
a = init_builtin (builtin_type, "make-module-type", 0, (function1_t) & make_module_type, a);
|
||||
a = init_builtin (builtin_type, "module-printer", 1, (function1_t) & module_printer, a);
|
||||
a = init_builtin (builtin_type, "module-variable", 2, (function1_t) & module_variable, a);
|
||||
a = init_builtin (builtin_type, "module-ref", 2, (function1_t) & module_ref, a);
|
||||
a = init_builtin (builtin_type, "module-define!", 3, (function1_t) & module_define_x, a);
|
||||
// src/posix.mes
|
||||
a = init_builtin (builtin_type, "peek-byte", 0, (function1_t) & peek_byte, a);
|
||||
a = init_builtin (builtin_type, "read-byte", 0, (function1_t) & read_byte, a);
|
||||
a = init_builtin (builtin_type, "unread-byte", 1, (function1_t) & unread_byte, a);
|
||||
a = init_builtin (builtin_type, "peek-char", 0, (function1_t) & peek_char, a);
|
||||
a = init_builtin (builtin_type, "read-char", -1, (function1_t) & read_char, a);
|
||||
a = init_builtin (builtin_type, "unread-char", 1, (function1_t) & unread_char, a);
|
||||
a = init_builtin (builtin_type, "write-char", -1, (function1_t) & write_char, a);
|
||||
a = init_builtin (builtin_type, "write-byte", -1, (function1_t) & write_byte, a);
|
||||
a = init_builtin (builtin_type, "getenv", 1, (function1_t) & getenv_, a);
|
||||
a = init_builtin (builtin_type, "setenv", 2, (function1_t) & setenv_, a);
|
||||
a = init_builtin (builtin_type, "access?", 2, (function1_t) & access_p, a);
|
||||
a = init_builtin (builtin_type, "current-input-port", 0, (function1_t) & current_input_port, a);
|
||||
a = init_builtin (builtin_type, "open-input-file", 1, (function1_t) & open_input_file, a);
|
||||
a = init_builtin (builtin_type, "open-input-string", 1, (function1_t) & open_input_string, a);
|
||||
a = init_builtin (builtin_type, "set-current-input-port", 1, (function1_t) & set_current_input_port, a);
|
||||
a = init_builtin (builtin_type, "current-output-port", 0, (function1_t) & current_output_port, a);
|
||||
a = init_builtin (builtin_type, "current-error-port", 0, (function1_t) & current_error_port, a);
|
||||
a = init_builtin (builtin_type, "open-output-file", -1, (function1_t) & open_output_file, a);
|
||||
a = init_builtin (builtin_type, "set-current-output-port", 1, (function1_t) & set_current_output_port, a);
|
||||
a = init_builtin (builtin_type, "set-current-error-port", 1, (function1_t) & set_current_error_port, a);
|
||||
a = init_builtin (builtin_type, "chmod", 2, (function1_t) & chmod_, a);
|
||||
a = init_builtin (builtin_type, "isatty?", 1, (function1_t) & isatty_p, a);
|
||||
a = init_builtin (builtin_type, "primitive-fork", 0, (function1_t) & primitive_fork, a);
|
||||
a = init_builtin (builtin_type, "execl", 2, (function1_t) & execl_, a);
|
||||
a = init_builtin (builtin_type, "core:waitpid", 2, (function1_t) & waitpid_, a);
|
||||
a = init_builtin (builtin_type, "current-time", 0, (function1_t) & current_time, a);
|
||||
a = init_builtin (builtin_type, "gettimeofday", 0, (function1_t) & gettimeofday_, a);
|
||||
a = init_builtin (builtin_type, "get-internal-run-time", 0, (function1_t) & get_internal_run_time, a);
|
||||
a = init_builtin (builtin_type, "getcwd", 0, (function1_t) & getcwd_, a);
|
||||
a = init_builtin (builtin_type, "dup", 1, (function1_t) & dup_, a);
|
||||
a = init_builtin (builtin_type, "dup2", 2, (function1_t) & dup2_, a);
|
||||
a = init_builtin (builtin_type, "delete-file", 1, (function1_t) & delete_file, a);
|
||||
// src/reader.mes
|
||||
a = init_builtin (builtin_type, "core:read-input-file-env", 2, (function1_t) & read_input_file_env_, a);
|
||||
a = init_builtin (builtin_type, "read-input-file-env", 1, (function1_t) & read_input_file_env, a);
|
||||
a = init_builtin (builtin_type, "read-env", 1, (function1_t) & read_env, a);
|
||||
a = init_builtin (builtin_type, "reader-read-sexp", 3, (function1_t) & reader_read_sexp, a);
|
||||
a = init_builtin (builtin_type, "reader-read-character", 0, (function1_t) & reader_read_character, a);
|
||||
a = init_builtin (builtin_type, "reader-read-binary", 0, (function1_t) & reader_read_binary, a);
|
||||
a = init_builtin (builtin_type, "reader-read-octal", 0, (function1_t) & reader_read_octal, a);
|
||||
a = init_builtin (builtin_type, "reader-read-hex", 0, (function1_t) & reader_read_hex, a);
|
||||
a = init_builtin (builtin_type, "reader-read-string", 0, (function1_t) & reader_read_string, a);
|
||||
// src/strings.mes
|
||||
a = init_builtin (builtin_type, "string=?", 2, (function1_t) & string_equal_p, a);
|
||||
a = init_builtin (builtin_type, "symbol->string", 1, (function1_t) & symbol_to_string, a);
|
||||
a = init_builtin (builtin_type, "symbol->keyword", 1, (function1_t) & symbol_to_keyword, a);
|
||||
a = init_builtin (builtin_type, "keyword->string", 1, (function1_t) & keyword_to_string, a);
|
||||
a = init_builtin (builtin_type, "string->symbol", 1, (function1_t) & string_to_symbol, a);
|
||||
a = init_builtin (builtin_type, "make-symbol", 1, (function1_t) & make_symbol, a);
|
||||
a = init_builtin (builtin_type, "string->list", 1, (function1_t) & string_to_list, a);
|
||||
a = init_builtin (builtin_type, "list->string", 1, (function1_t) & list_to_string, a);
|
||||
a = init_builtin (builtin_type, "read-string", -1, (function1_t) & read_string, a);
|
||||
a = init_builtin (builtin_type, "string-append", -1, (function1_t) & string_append, a);
|
||||
a = init_builtin (builtin_type, "string-length", 1, (function1_t) & string_length, a);
|
||||
a = init_builtin (builtin_type, "string-ref", 2, (function1_t) & string_ref, a);
|
||||
// src/struct.mes
|
||||
a = init_builtin (builtin_type, "make-struct", 3, (function1_t) & make_struct, a);
|
||||
a = init_builtin (builtin_type, "struct-length", 1, (function1_t) & struct_length, a);
|
||||
a = init_builtin (builtin_type, "struct-ref", 2, (function1_t) & struct_ref, a);
|
||||
a = init_builtin (builtin_type, "struct-set!", 3, (function1_t) & struct_set_x, a);
|
||||
// src/vector.mes
|
||||
a = init_builtin (builtin_type, "core:make-vector", 1, (function1_t) & make_vector_, a);
|
||||
a = init_builtin (builtin_type, "vector-length", 1, (function1_t) & vector_length, a);
|
||||
a = init_builtin (builtin_type, "vector-ref", 2, (function1_t) & vector_ref, a);
|
||||
a = init_builtin (builtin_type, "vector-entry", 1, (function1_t) & vector_entry, a);
|
||||
a = init_builtin (builtin_type, "vector-set!", 3, (function1_t) & vector_set_x, a);
|
||||
a = init_builtin (builtin_type, "list->vector", 1, (function1_t) & list_to_vector, a);
|
||||
a = init_builtin (builtin_type, "vector->list", 1, (function1_t) & vector_to_list, a);
|
||||
|
||||
return a;
|
||||
}
|
||||
|
||||
int
|
||||
try_open_boot (char *file_name, char const *boot, char const *location)
|
||||
{
|
||||
|
|
|
|||
Loading…
Reference in New Issue