artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

core: Remove struct definitions for builtins, drop snarfing.

Browse source 
After making a change to the list of builtin functions, run

    cat src/*.i

and move the into

    src/mes.c:mes_builtins ()

and, or also after changing the list of fixed symbols in src/mes.c:mes_symbols (), do

    cat src/*.h > src/builtins.h

* build-aux/build.sh.in: Remove snarfing.
* build-aux/bootstrap.sh.in: Likewise.
* mes/module/mes/display.mes (display):
* mes/module/mes/type-0.mes (cell:type-alist): Remove <cell:function>.
(function?, builtin?): Remove.
* src/builtins.h: New file.
* src/mes.c (TFUNCTION): Remove.
(struct function): Remove.
(apply_builtin): Rewrite from call.
(mes_builtins): Rewrite.
(init_builtin, make_builtin_type, make_builtin, builtin_name,
builtin_arity, builtin, builtin_p, builtin_printer): New function.
This commit is contained in:
Jan Nieuwenhuizen 2019-01-04 09:55:16 +01:00
parent 04556c5636
commit 99ac7b59c4
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
13 changed files with 906 additions and 573 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
.gitignore vendored
View file

@ -76,8 +76,30 @@
/scaffold/tests/x86-mes-* /scaffold/tests/x86-mes-*
/scaffold/tests/[0-9a][0-9a-z]-[^.]* /scaffold/tests/[0-9a][0-9a-z]-[^.]*
/src/*.h /src/mes.mes.symbols.h
/src/*.i /src/gc.mes.h
/src/hash.mes.h
/src/lib.mes.h
/src/math.mes.h
/src/mes.mes.h
/src/module.mes.h
/src/posix.mes.h
/src/reader.mes.h
/src/strings.mes.h
/src/struct.mes.h
/src/vector.mes.h
/src/gc.mes.i
/src/hash.mes.i
/src/lib.mes.i
/src/math.mes.i
/src/mes.mes.i
/src/module.mes.i
/src/posix.mes.i
/src/reader.mes.i
/src/strings.mes.i
/src/struct.mes.i
/src/vector.mes.i
/src/mes /src/mes
/src/x86-mes-mes /src/x86-mes-mes
/src/x86_64-mes-mes /src/x86_64-mes-mes

12
build-aux/bootstrap.sh.in
View file

@ -10,18 +10,6 @@ MES_ARENA=${MES_ARENA-100000000}
MES_MAX_ARENA=${MES_MAX_ARENA-100000000} MES_MAX_ARENA=${MES_MAX_ARENA-100000000}
MES_STACK=${MES_STACK-500000} MES_STACK=${MES_STACK-500000}
@GUILE@ -e '(mes-snarf)' build-aux/mes-snarf.scm --mes src/gc.c
@GUILE@ -e '(mes-snarf)' build-aux/mes-snarf.scm --mes src/hash.c
@GUILE@ -e '(mes-snarf)' build-aux/mes-snarf.scm --mes src/lib.c
@GUILE@ -e '(mes-snarf)' build-aux/mes-snarf.scm --mes src/math.c
@GUILE@ -e '(mes-snarf)' build-aux/mes-snarf.scm --mes src/mes.c
@GUILE@ -e '(mes-snarf)' build-aux/mes-snarf.scm --mes src/module.c
@GUILE@ -e '(mes-snarf)' build-aux/mes-snarf.scm --mes src/posix.c
@GUILE@ -e '(mes-snarf)' build-aux/mes-snarf.scm --mes src/reader.c
@GUILE@ -e '(mes-snarf)' build-aux/mes-snarf.scm --mes src/strings.c
@GUILE@ -e '(mes-snarf)' build-aux/mes-snarf.scm --mes src/struct.c
@GUILE@ -e '(mes-snarf)' build-aux/mes-snarf.scm --mes src/vector.c
hex2 --LittleEndian --Architecture 1 --BaseAddress 0x1000000 -f lib/x86-mes/elf32-0header.hex2 -f lib/x86-mes/elf32-body-exit-42.hex2 -f lib/x86-mes/elf-0footer.hex2 --exec_enable -o lib/x86-mes/0exit-42 hex2 --LittleEndian --Architecture 1 --BaseAddress 0x1000000 -f lib/x86-mes/elf32-0header.hex2 -f lib/x86-mes/elf32-body-exit-42.hex2 -f lib/x86-mes/elf-0footer.hex2 --exec_enable -o lib/x86-mes/0exit-42
hex2 --LittleEndian --Architecture 1 --BaseAddress 0x1000000 -f lib/x86-mes/elf32-header.hex2 -f lib/x86-mes/elf32-body-exit-42.hex2 -f lib/x86-mes/elf32-footer-single-main.hex2 --exec_enable -o lib/x86-mes/exit-42 hex2 --LittleEndian --Architecture 1 --BaseAddress 0x1000000 -f lib/x86-mes/elf32-header.hex2 -f lib/x86-mes/elf32-body-exit-42.hex2 -f lib/x86-mes/elf32-footer-single-main.hex2 --exec_enable -o lib/x86-mes/exit-42
M1 --LittleEndian --Architecture 1 -f lib/x86-mes/x86.M1 -f @MES_SEED@/x86-mes/crt1.S -o lib/x86-mes/crt1.o M1 --LittleEndian --Architecture 1 -f lib/x86-mes/x86.M1 -f @MES_SEED@/x86-mes/crt1.S -o lib/x86-mes/crt1.o

7
build-aux/build.sh.in
View file

@ -27,13 +27,6 @@ if [ -n "$GUILE" -a "$GUILE" != true ]; then
sh ${srcdest}build-aux/build-guile.sh sh ${srcdest}build-aux/build-guile.sh
fi fi
if [ ! "$mes_p" ]; then
sh ${srcdest}build-aux/snarf.sh
#elif [ ! -d "$MES_SEED" ]; then
#else
fi
sh ${srcdest}build-aux/snarf.sh --mes
if [ "$gcc_p$tcc_p" ]; then if [ "$gcc_p$tcc_p" ]; then
sh ${srcdest}build-aux/build-mes.sh sh ${srcdest}build-aux/build-mes.sh
elif [ -d "$MES_SEED" ]; then elif [ -d "$MES_SEED" ]; then

26
build-aux/snarf.sh
View file

@ -23,18 +23,14 @@ set -e
. ${srcdest}build-aux/config.sh . ${srcdest}build-aux/config.sh
. ${srcdest}build-aux/trace.sh . ${srcdest}build-aux/trace.sh
snarf=" " trace "SNARF$snarf gc.c" ${srcdest}build-aux/mes-snarf.scm src/gc.c
if [ -n "$1" ]; then trace "SNARF$snarf hash.c" ${srcdest}build-aux/mes-snarf.scm src/hash.c
snarf=.mes trace "SNARF$snarf lib.c" ${srcdest}build-aux/mes-snarf.scm src/lib.c
fi trace "SNARF$snarf math.c" ${srcdest}build-aux/mes-snarf.scm src/math.c
trace "SNARF$snarf gc.c" ${srcdest}build-aux/mes-snarf.scm $1 src/gc.c trace "SNARF$snarf mes.c" ${srcdest}build-aux/mes-snarf.scm src/mes.c
trace "SNARF$snarf hash.c" ${srcdest}build-aux/mes-snarf.scm $1 src/hash.c trace "SNARF$snarf module.c" ${srcdest}build-aux/mes-snarf.scm src/module.c
trace "SNARF$snarf lib.c" ${srcdest}build-aux/mes-snarf.scm $1 src/lib.c trace "SNARF$snarf posix.c" ${srcdest}build-aux/mes-snarf.scm src/posix.c
trace "SNARF$snarf math.c" ${srcdest}build-aux/mes-snarf.scm $1 src/math.c trace "SNARF$snarf reader.c" ${srcdest}build-aux/mes-snarf.scm src/reader.c
trace "SNARF$snarf mes.c" ${srcdest}build-aux/mes-snarf.scm $1 src/mes.c trace "SNARF$snarf strings.c" ${srcdest}build-aux/mes-snarf.scm src/strings.c
trace "SNARF$snarf module.c" ${srcdest}build-aux/mes-snarf.scm $1 src/module.c trace "SNARF$snarf struct.c" ${srcdest}build-aux/mes-snarf.scm src/struct.c
trace "SNARF$snarf posix.c" ${srcdest}build-aux/mes-snarf.scm $1 src/posix.c trace "SNARF$snarf vector.c" ${srcdest}build-aux/mes-snarf.scm src/vector.c
trace "SNARF$snarf reader.c" ${srcdest}build-aux/mes-snarf.scm $1 src/reader.c
trace "SNARF$snarf strings.c" ${srcdest}build-aux/mes-snarf.scm $1 src/strings.c
trace "SNARF$snarf struct.c" ${srcdest}build-aux/mes-snarf.scm $1 src/struct.c
trace "SNARF$snarf vector.c" ${srcdest}build-aux/mes-snarf.scm $1 src/vector.c

32
mes/module/mes/display.mes
View file

@ -148,13 +148,30 @@
(if (keyword? x) (display "#:" port)) (if (keyword? x) (display "#:" port))
(for-each (display-cut2 display-char <> port write?) (string->list x)) (for-each (display-cut2 display-char <> port write?) (string->list x))
(if (and (string? x) write?) (write-char #\" port))) (if (and (string? x) write?) (write-char #\" port)))
((builtin? x)
(display "#<procedure " port)
(display (builtin-name x) port)
(display " " port)
(display
(case (builtin-arity x)
((-1) "_")
((0) "()")
((1) "(_)")
((2) "(_ _)")
((3) "(_ _ _)"))
port)
(display ">" port))
((struct? x) ((struct? x)
(let* ((printer (struct-ref x 1)))
(if (or (builtin? printer) (closure? printer))
(printer x)
(begin
(display "#<" port) (display "#<" port)
(for-each (lambda (i) (for-each (lambda (i)
(let ((x (struct-ref x i))) (let ((x (struct-ref x i)))
(d x #f (if (= i 0) "" " ")))) (d x #f (if (= i 0) "" " "))))
(iota (struct-length x))) (iota (struct-length x)))
(display ")" port)) (display ")" port)))))
((vector? x) ((vector? x)
(display "#(" port) (display "#(" port)
(for-each (lambda (i) (for-each (lambda (i)
@ -166,19 +183,6 @@
(d x #f (if (= i 0) "" " "))))) (d x #f (if (= i 0) "" " ")))))
(iota (vector-length x))) (iota (vector-length x)))
(display ")" port)) (display ")" port))
((function? x)
(display "#<procedure " port)
(display (core:procedure-name x) port)
(display " " port)
(display
(case (core:arity x)
((-1) "_")
((0) "()")
((1) "(_)")
((2) "(_ _)")
((3) "(_ _ _)"))
port)
(display ">" port))
((broken-heart? x) ((broken-heart? x)
(display "<3" port)) (display "<3" port))
(#t (#t

6
mes/module/mes/type-0.mes
View file

@ -30,7 +30,6 @@
(cons <cell:char> (quote <cell:char>)) (cons <cell:char> (quote <cell:char>))
(cons <cell:closure> (quote <cell:closure>)) (cons <cell:closure> (quote <cell:closure>))
(cons <cell:continuation> (quote <cell:continuation>)) (cons <cell:continuation> (quote <cell:continuation>))
(cons <cell:function> (quote <cell:function>))
(cons <cell:keyword> (quote <cell:keyword>)) (cons <cell:keyword> (quote <cell:keyword>))
(cons <cell:macro> (quote <cell:macro>)) (cons <cell:macro> (quote <cell:macro>))
(cons <cell:number> (quote <cell:number>)) (cons <cell:number> (quote <cell:number>))
@ -65,11 +64,6 @@
(define (continuation? x) (define (continuation? x)
(eq? (core:type x) <cell:continuation>)) (eq? (core:type x) <cell:continuation>))
(define (function? x)
(eq? (core:type x) <cell:function>))
(define builtin? function?)
(define (keyword? x) (define (keyword? x)
(eq? (core:type x) <cell:keyword>)) (eq? (core:type x) <cell:keyword>))

391
src/builtins.h Normal file
View file

@ -0,0 +1,391 @@
// src/gc.mes
SCM gc_check ();
SCM gc ();
// 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);
SCM hashq_ref (SCM table, SCM key, SCM dflt);
SCM hash_ref (SCM table, SCM key, SCM dflt);
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
SCM procedure_name_ (SCM x);
SCM display_ (SCM x);
SCM display_error_ (SCM x);
SCM display_port_ (SCM x, SCM p);
SCM write_ (SCM x);
SCM write_error_ (SCM x);
SCM write_port_ (SCM x, SCM p);
SCM exit_ (SCM x);
SCM frame_printer (SCM frame);
SCM make_stack (SCM stack);
SCM stack_length (SCM stack);
SCM stack_ref (SCM stack, SCM index);
SCM xassq (SCM x, SCM a);
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
SCM greater_p (SCM x);
SCM less_p (SCM x);
SCM is_p (SCM x);
SCM minus (SCM x);
SCM plus (SCM x);
SCM divide (SCM x);
SCM modulo (SCM a, SCM b);
SCM multiply (SCM x);
SCM logand (SCM x);
SCM logior (SCM x);
SCM lognot (SCM x);
SCM logxor (SCM x);
SCM ash (SCM n, SCM count);
// src/mes.mes
SCM make_cell_ (SCM type, SCM car, SCM cdr);
SCM type_ (SCM x);
SCM car_ (SCM x);
SCM cdr_ (SCM x);
SCM arity_ (SCM x);
SCM cons (SCM x, SCM y);
SCM car (SCM x);
SCM cdr (SCM x);
SCM list (SCM x);
SCM null_p (SCM x);
SCM eq_p (SCM x, SCM y);
SCM values (SCM x);
SCM acons (SCM key, SCM value, SCM alist);
SCM length (SCM x);
SCM error (SCM key, SCM x);
SCM append2 (SCM x, SCM y);
SCM append_reverse (SCM x, SCM y);
SCM reverse_x_ (SCM x, SCM t);
SCM pairlis (SCM x, SCM y, SCM a);
SCM call (SCM fn, SCM x);
SCM assq (SCM x, SCM a);
SCM assoc (SCM x, SCM a);
SCM set_car_x (SCM x, SCM e);
SCM set_cdr_x (SCM x, SCM e);
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
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
SCM peek_byte ();
SCM read_byte ();
SCM unread_byte (SCM i);
SCM peek_char ();
SCM read_char (SCM port);
SCM unread_char (SCM i);
SCM write_char (SCM i);
SCM write_byte (SCM x);
SCM getenv_ (SCM s);
SCM setenv_ (SCM s, SCM v);
SCM access_p (SCM file_name, SCM mode);
SCM current_input_port ();
SCM open_input_file (SCM file_name);
SCM open_input_string (SCM string);
SCM set_current_input_port (SCM port);
SCM current_output_port ();
SCM current_error_port ();
SCM open_output_file (SCM x);
SCM set_current_output_port (SCM port);
SCM set_current_error_port (SCM port);
SCM force_output (SCM p);
SCM chmod_ (SCM file_name, SCM mode);
SCM isatty_p (SCM port);
SCM primitive_fork ();
SCM execl_ (SCM file_name, SCM args);
SCM waitpid_ (SCM pid, SCM options);
SCM current_time ();
SCM gettimeofday_ ();
SCM get_internal_run_time ();
SCM getcwd_ ();
SCM dup_ (SCM port);
SCM dup2_ (SCM old, SCM new);
SCM delete_file (SCM file_name);
// src/reader.mes
SCM read_input_file_env_ (SCM e, SCM a);
SCM read_input_file_env (SCM a);
SCM read_env (SCM a);
SCM reader_read_sexp (SCM c, SCM s, SCM a);
SCM reader_read_character ();
SCM reader_read_binary ();
SCM reader_read_octal ();
SCM reader_read_hex ();
SCM reader_read_string ();
// src/strings.mes
SCM string_equal_p (SCM a, SCM b);
SCM symbol_to_string (SCM symbol);
SCM symbol_to_keyword (SCM symbol);
SCM keyword_to_string (SCM keyword);
SCM string_to_symbol (SCM string);
SCM make_symbol (SCM string);
SCM string_to_list (SCM string);
SCM list_to_string (SCM list);
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
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
SCM make_vector_ (SCM n);
SCM vector_length (SCM x);
SCM vector_ref (SCM x, SCM i);
SCM vector_entry (SCM x);
SCM vector_set_x (SCM x, SCM i, SCM e);
SCM list_to_vector (SCM x);
SCM vector_to_list (SCM v);

3
src/gc.c
View file

@ -124,7 +124,7 @@ gc_loop (SCM scan) ///((internal))
while (scan < g_free) while (scan < g_free)
{ {
if (NTYPE (scan) == TBROKEN_HEART) if (NTYPE (scan) == TBROKEN_HEART)
error (cell_symbol_system_error, cell_gc); error (cell_symbol_system_error, cstring_to_symbol ("gc"));
if (NTYPE (scan) == TMACRO if (NTYPE (scan) == TMACRO
|| NTYPE (scan) == TPAIR || NTYPE (scan) == TPAIR
|| NTYPE (scan) == TREF || NTYPE (scan) == TREF
@ -136,7 +136,6 @@ gc_loop (SCM scan) ///((internal))
} }
if ((NTYPE (scan) == TCLOSURE if ((NTYPE (scan) == TCLOSURE
|| NTYPE (scan) == TCONTINUATION || NTYPE (scan) == TCONTINUATION
|| NTYPE (scan) == TFUNCTION
|| NTYPE (scan) == TKEYWORD || NTYPE (scan) == TKEYWORD
|| NTYPE (scan) == TMACRO || NTYPE (scan) == TMACRO
|| NTYPE (scan) == TPAIR || NTYPE (scan) == TPAIR

3
src/hash.c
View file

@ -221,7 +221,8 @@ make_hash_table_ (long size)
values = cons (buckets, values); values = cons (buckets, values);
values = cons (MAKE_NUMBER (size), values); values = cons (MAKE_NUMBER (size), values);
values = cons (cell_symbol_hashq_table, values); values = cons (cell_symbol_hashq_table, values);
return make_struct (hashq_type, values, cell_hash_table_printer); //FIXME: symbol/printer return make_struct (hashq_type, values, cstring_to_symbol ("hash-table-printer");
return make_struct (hashq_type, values, cell_unspecified);
} }
SCM SCM

35
src/lib.c
View file

@ -18,6 +18,11 @@
* along with GNU Mes. If not, see <http://www.gnu.org/licenses/>. * along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
*/ */
// CONSTANT STRUCT_TYPE 0
#define STRUCT_TYPE 0
// CONSTANT STRUCT_PRINTER 1
#define STRUCT_PRINTER 1
int g_depth; int g_depth;
SCM fdisplay_ (SCM, int, int); SCM fdisplay_ (SCM, int, int);
@ -68,19 +73,6 @@ display_helper (SCM x, int cont, char* sep, int fd, int write_p)
display_helper (args, 0, "", fd, 0); display_helper (args, 0, "", fd, 0);
fdputs (">", fd); fdputs (">", fd);
} }
else if (t == TFUNCTION)
{
fdputs ("#<procedure ", fd);
char const *p = "?";
if (FUNCTION (x).name != 0)
p = FUNCTION (x).name;
fdputs (p, fd);
fdputs ("[", fd);
fdputs (itoa (CDR (x)), fd);
fdputs (",", fd);
fdputs (itoa (x), fd);
fdputs ("]>", fd);
}
else if (t == TMACRO) else if (t == TMACRO)
{ {
fdputs ("#<macro ", fd); fdputs ("#<macro ", fd);
@ -186,11 +178,12 @@ display_helper (SCM x, int cont, char* sep, int fd, int write_p)
fdisplay_ (REF (x), fd, write_p); fdisplay_ (REF (x), fd, write_p);
else if (t == TSTRUCT) else if (t == TSTRUCT)
{ {
SCM printer = STRUCT (x) + 1; //SCM printer = STRUCT (x) + 1;
SCM printer = struct_ref_ (x, STRUCT_PRINTER);
if (TYPE (printer) == TREF) if (TYPE (printer) == TREF)
printer = REF (printer); printer = REF (printer);
if (TYPE (printer) == TCLOSURE if (TYPE (printer) == TCLOSURE
|| TYPE (printer) == TFUNCTION) || builtin_p (printer) == cell_t)
apply (printer, cons (x, cell_nil), r0); apply (printer, cons (x, cell_nil), r0);
else else
{ {
@ -229,16 +222,6 @@ display_helper (SCM x, int cont, char* sep, int fd, int write_p)
return 0; return 0;
} }
SCM
procedure_name_ (SCM x)
{
assert (TYPE (x) == TFUNCTION);
char const *p = "?";
if (FUNCTION (x).name != 0)
p = FUNCTION (x).name;
return MAKE_STRING0 (p);
}
SCM SCM
display_ (SCM x) display_ (SCM x)
{ {
@ -326,7 +309,7 @@ make_frame (SCM stack, long index)
SCM values = cell_nil; SCM values = cell_nil;
values = cons (procedure, values); values = cons (procedure, values);
values = cons (cell_symbol_frame, values); values = cons (cell_symbol_frame, values);
return make_struct (frame_type, values, cell_frame_printer); return make_struct (frame_type, values, cstring_to_symbol ("frame-printer"));
} }
SCM SCM

921
src/mes.c
View file

File diff suppressed because it is too large Load diff

2
src/module.c
View file

@ -53,7 +53,7 @@ make_initial_module (SCM a) ///((internal))
values = cons (locals, values); values = cons (locals, values);
values = cons (name, values); values = cons (name, values);
values = cons (cell_symbol_module, values); values = cons (cell_symbol_module, values);
SCM module = make_struct (module_type, values, cell_module_printer); SCM module = make_struct (module_type, values, cstring_to_symbol ("module-printer"));
r0 = cell_nil; r0 = cell_nil;
r0 = cons (CADR (a), r0); r0 = cons (CADR (a), r0);
r0 = cons (CAR (a), r0); r0 = cons (CAR (a), r0);

5
src/struct.c
View file

@ -18,6 +18,11 @@
* along with GNU Mes. If not, see <http://www.gnu.org/licenses/>. * along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
*/ */
// CONSTANT STRUCT_TYPE 0
#define STRUCT_TYPE 0
// CONSTANT STRUCT_PRINTER 1
#define STRUCT_PRINTER 1
SCM SCM
make_struct (SCM type, SCM fields, SCM printer) make_struct (SCM type, SCM fields, SCM printer)
{ {