core: Remove struct definitions for builtins, drop snarfing.
authorJan Nieuwenhuizen <janneke@gnu.org>
Fri, 4 Jan 2019 08:55:16 +0000 (09:55 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Fri, 4 Jan 2019 08:55:16 +0000 (09:55 +0100)
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.

13 files changed:
.gitignore
build-aux/bootstrap.sh.in
build-aux/build.sh.in
build-aux/snarf.sh
mes/module/mes/display.mes
mes/module/mes/type-0.mes
src/builtins.h [new file with mode: 0644]
src/gc.c
src/hash.c
src/lib.c
src/mes.c
src/module.c
src/struct.c

index c68691743d0ddaf043a9265c6f1b6274a23390b9..55b00357cc2820b509e3f5aff40c8afca0b0a418 100644 (file)
 /scaffold/tests/x86-mes-*
 /scaffold/tests/[0-9a][0-9a-z]-[^.]*
 
-/src/*.h
-/src/*.i
+/src/mes.mes.symbols.h
+/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/x86-mes-mes
 /src/x86_64-mes-mes
index 6ec12e877e5ade1982ed69a6746bac4cad3e1d09..ca1ece6ff85b6e62fed059cd4ea06a823f8d5bda 100644 (file)
@@ -10,18 +10,6 @@ MES_ARENA=${MES_ARENA-100000000}
 MES_MAX_ARENA=${MES_MAX_ARENA-100000000}
 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-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
index ceb4d78ac2605a0a2993091d91cc0d1e8affeefe..68727d30972d82835300880db74f0aeda69f7769 100644 (file)
@@ -27,13 +27,6 @@ if [ -n "$GUILE" -a "$GUILE" != true ]; then
     sh ${srcdest}build-aux/build-guile.sh
 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
     sh ${srcdest}build-aux/build-mes.sh
 elif [ -d "$MES_SEED" ]; then
index 07f8f78df7576fbe66dd39b3b7a9a2e2c2fe3e80..7f544a11334a4bcb3122509a2a4332758b685c75 100755 (executable)
@@ -23,18 +23,14 @@ set -e
 . ${srcdest}build-aux/config.sh
 . ${srcdest}build-aux/trace.sh
 
-snarf="    "
-if [ -n "$1" ]; then
-    snarf=.mes
-fi
-trace "SNARF$snarf  gc.c"      ${srcdest}build-aux/mes-snarf.scm $1 src/gc.c
-trace "SNARF$snarf  hash.c"    ${srcdest}build-aux/mes-snarf.scm $1 src/hash.c
-trace "SNARF$snarf  lib.c"     ${srcdest}build-aux/mes-snarf.scm $1 src/lib.c
-trace "SNARF$snarf  math.c"    ${srcdest}build-aux/mes-snarf.scm $1 src/math.c
-trace "SNARF$snarf  mes.c"     ${srcdest}build-aux/mes-snarf.scm $1 src/mes.c
-trace "SNARF$snarf  module.c"  ${srcdest}build-aux/mes-snarf.scm $1 src/module.c
-trace "SNARF$snarf  posix.c"   ${srcdest}build-aux/mes-snarf.scm $1 src/posix.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
+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/strings.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
index 71a1fb0e3de9eed8b8b663793b2b6a9cf40edd05..6d3f59d89ea8455b7a8c753801db560e2a67f2ea 100644 (file)
         (if (keyword? x) (display "#:" port))
         (for-each (display-cut2 display-char <> port write?) (string->list x))
         (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)
-        (display "#<" port)
-        (for-each (lambda (i)
-                    (let ((x (struct-ref x i)))
-                      (d x #f (if (= i 0) "" " "))))
-                  (iota (struct-length x)))
-        (display ")" port))
+        (let* ((printer (struct-ref x 1)))
+          (if (or (builtin? printer) (closure? printer))
+              (printer x)
+              (begin
+                (display "#<" port)
+                (for-each (lambda (i)
+                            (let ((x (struct-ref x i)))
+                              (d x #f (if (= i 0) "" " "))))
+                          (iota (struct-length x)))
+                (display ")" port)))))
        ((vector? x)
         (display "#(" port)
         (for-each (lambda (i)
                           (d x #f (if (= i 0) "" " ")))))
                   (iota (vector-length x)))
         (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)
         (display "<3" port))
        (#t
index e81868fdfbf69a3e663186b64d21c3cca0337204..e01e6e50dd790ca67433f30c73c04f5f186f2a3f 100644 (file)
@@ -30,7 +30,6 @@
         (cons <cell:char> (quote <cell:char>))
         (cons <cell:closure> (quote <cell:closure>))
         (cons <cell:continuation> (quote <cell:continuation>))
-        (cons <cell:function> (quote <cell:function>))
         (cons <cell:keyword> (quote <cell:keyword>))
         (cons <cell:macro> (quote <cell:macro>))
         (cons <cell:number> (quote <cell:number>))
 (define (continuation? x)
   (eq? (core:type x) <cell:continuation>))
 
-(define (function? x)
-  (eq? (core:type x) <cell:function>))
-
-(define builtin? function?)
-
 (define (keyword? x)
   (eq? (core:type x) <cell:keyword>))
 
diff --git a/src/builtins.h b/src/builtins.h
new file mode 100644 (file)
index 0000000..cfd0b92
--- /dev/null
@@ -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);
index 498bd859167889d71deca3b3b1e85dd970f583a3..21e2675e11e3328b7e168c3797bbeeeee98c67a5 100644 (file)
--- a/src/gc.c
+++ b/src/gc.c
@@ -124,7 +124,7 @@ gc_loop (SCM scan) ///((internal))
   while (scan < g_free)
     {
       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
           || NTYPE (scan) == TPAIR
           || NTYPE (scan) == TREF
@@ -136,7 +136,6 @@ gc_loop (SCM scan) ///((internal))
         }
       if ((NTYPE (scan) == TCLOSURE
            || NTYPE (scan) == TCONTINUATION
-           || NTYPE (scan) == TFUNCTION
            || NTYPE (scan) == TKEYWORD
            || NTYPE (scan) == TMACRO
            || NTYPE (scan) == TPAIR
index ab963c3801989802ef74e6a69768347fb22cc20f..1e2c4a81caa42e1e4c17db8583468a0ecf69d58f 100644 (file)
@@ -221,7 +221,8 @@ make_hash_table_ (long size)
   values = cons (buckets, values);
   values = cons (MAKE_NUMBER (size), 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
index e16dc653f4c3251b6b073b22f70f007f6009e003..944848216eaabee1351bf98ca009221a779ed4c9 100644 (file)
--- a/src/lib.c
+++ b/src/lib.c
  * 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;
 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);
       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)
     {
       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);
   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)
         printer = REF (printer);
       if (TYPE (printer) == TCLOSURE
-          || TYPE (printer) == TFUNCTION)
+          || builtin_p (printer) == cell_t)
         apply (printer, cons (x, cell_nil), r0);
       else
         {
@@ -229,16 +222,6 @@ display_helper (SCM x, int cont, char* sep, int fd, int write_p)
   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
 display_ (SCM x)
 {
@@ -326,7 +309,7 @@ make_frame (SCM stack, long index)
   SCM values = cell_nil;
   values = cons (procedure, 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
index 89a03fcc7f10d3f2fb70dfb2dd1ca889bba46e6a..338de0e178e6905bddb198733a3923e1610c6283 100644 (file)
--- a/src/mes.c
+++ b/src/mes.c
@@ -18,6 +18,7 @@
  * along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
+#include <fcntl.h>
 #include <stdio.h>
 #include <assert.h>
 #include <stdint.h>
@@ -63,14 +64,6 @@ SCM m0 = 0;
 SCM g_macros = 0;
 SCM g_ports = 1;
 
-#if __x86_64__
-#define HALFLONG_MAX UINT_MAX
-typedef int halflong;
-#else
-#define HALFLONG_MAX UINT16_MAX
-typedef short halflong;
-#endif
-
 // CONSTANT TBYTES         0
 #define TBYTES             0
 // CONSTANT TCHAR          1
@@ -79,101 +72,46 @@ typedef short halflong;
 #define TCLOSURE           2
 // CONSTANT TCONTINUATION  3
 #define TCONTINUATION      3
-// CONSTANT TFUNCTION      4
-#define TFUNCTION          4
-// CONSTANT TKEYWORD       5
-#define TKEYWORD           5
-// CONSTANT TMACRO         6
-#define TMACRO             6
-// CONSTANT TNUMBER        7
-#define TNUMBER            7
-// CONSTANT TPAIR          8
-#define TPAIR              8
-// CONSTANT TPORT          9
-#define TPORT              9
-// CONSTANT TREF          10
-#define TREF              10
-// CONSTANT TSPECIAL      11
-#define TSPECIAL          11
-// CONSTANT TSTRING       12
-#define TSTRING           12
-// CONSTANT TSTRUCT       13
-#define TSTRUCT           13
-// CONSTANT TSYMBOL       14
-#define TSYMBOL           14
-// CONSTANT TVALUES       15
-#define TVALUES           15
-// CONSTANT TVARIABLE     16
-#define TVARIABLE         16
-// CONSTANT TVECTOR       17
-#define TVECTOR           17
-// CONSTANT TBROKEN_HEART 18
-#define TBROKEN_HEART     18
+// CONSTANT TKEYWORD       4
+#define TKEYWORD           4
+// CONSTANT TMACRO         5
+#define TMACRO             5
+// CONSTANT TNUMBER        6
+#define TNUMBER            6
+// CONSTANT TPAIR          7
+#define TPAIR              7
+// CONSTANT TPORT          8
+#define TPORT              8
+// CONSTANT TREF           9
+#define TREF               9
+// CONSTANT TSPECIAL      10
+#define TSPECIAL          10
+// CONSTANT TSTRING       11
+#define TSTRING           11
+// CONSTANT TSTRUCT       12
+#define TSTRUCT           12
+// CONSTANT TSYMBOL       13
+#define TSYMBOL           13
+// CONSTANT TVALUES       14
+#define TVALUES           14
+// CONSTANT TVARIABLE     15
+#define TVARIABLE         15
+// CONSTANT TVECTOR       16
+#define TVECTOR           16
+// CONSTANT TBROKEN_HEART 17
+#define TBROKEN_HEART     17
 
 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);
-#if !POSIX
-struct scm {
+struct scm
+{
   long type;
   SCM car;
   SCM cdr;
 };
-struct function {
-#if __M2_PLANET__
-  FUNCTION function;
-#else // !__M2_PLANET__
-  SCM (*function) (SCM);
-#endif // !__M2_PLANET__
-  long arity;
-  char *name;
-};
-#else
-struct function {
-  union {
-    function0_t function0;
-    function1_t function1;
-    function2_t function2;
-    function3_t function3;
-    functionn_t functionn;
-  };
-  long arity;
-  char const *name;
-};
-struct scm {
-  long type;
-  union
-  {
-#if 0
-    struct
-    {
-      unsigned halflong start;
-      unsigned halflong end;
-    };
-#endif
-    unsigned long function;
-    unsigned long length;
-    long port;
-    SCM car;
-    SCM macro;
-    SCM ref;
-    SCM variable;
-  };
-  union
-  {
-    long value;
-    char const* name;
-    char const* bytes;
-    SCM cdr;
-    SCM closure;
-    SCM continuation;
-    SCM string;
-    SCM vector;
-  };
-};
-#endif
 
 #if __MESC__
 //FIXME
@@ -357,110 +295,84 @@ struct scm *g_news = 0;
 
 // CONSTANT cell_symbol_buckets 82
 #define cell_symbol_buckets 82
-// CONSTANT cell_symbol_frame 83
-#define cell_symbol_frame 83
-// CONSTANT cell_symbol_hashq_table 84
-#define cell_symbol_hashq_table 84
-// CONSTANT cell_symbol_module 85
-#define cell_symbol_module 85
-// CONSTANT cell_symbol_procedure 86
-#define cell_symbol_procedure 86
-// CONSTANT cell_symbol_record_type 87
-#define cell_symbol_record_type 87
-// CONSTANT cell_symbol_size 88
-#define cell_symbol_size 88
-// CONSTANT cell_symbol_stack 89
-#define cell_symbol_stack 89
-
-// CONSTANT cell_symbol_argv 90
-#define cell_symbol_argv 90
-// CONSTANT cell_symbol_mes_prefix 91
-#define cell_symbol_mes_prefix 91
-// CONSTANT cell_symbol_mes_version 92
-#define cell_symbol_mes_version 92
-
-// CONSTANT cell_symbol_internal_time_units_per_second 93
-#define cell_symbol_internal_time_units_per_second 93
-// CONSTANT cell_symbol_compiler 94
-#define cell_symbol_compiler 94
-// CONSTANT cell_symbol_arch 95
-#define cell_symbol_arch 95
-
-// CONSTANT cell_symbol_pmatch_car 96
-#define cell_symbol_pmatch_car 96
-// CONSTANT cell_symbol_pmatch_cdr 97
-#define cell_symbol_pmatch_cdr 97
-
-// CONSTANT cell_type_bytes 98
-#define cell_type_bytes 98
-// CONSTANT cell_type_char 99
-#define cell_type_char 99
-// CONSTANT cell_type_closure 100
-#define cell_type_closure 100
-// CONSTANT cell_type_continuation 101
-#define cell_type_continuation 101
-// CONSTANT cell_type_function 102
-#define cell_type_function 102
-// CONSTANT cell_type_keyword 103
-#define cell_type_keyword 103
-// CONSTANT cell_type_macro 104
-#define cell_type_macro 104
-// CONSTANT cell_type_number 105
-#define cell_type_number 105
-// CONSTANT cell_type_pair 106
-#define cell_type_pair 106
-// CONSTANT cell_type_port 107
-#define cell_type_port 107
-// CONSTANT cell_type_ref 108
-#define cell_type_ref 108
-// CONSTANT cell_type_special 109
-#define cell_type_special 109
-// CONSTANT cell_type_string 110
-#define cell_type_string 110
-// CONSTANT cell_type_struct 111
-#define cell_type_struct 111
-// CONSTANT cell_type_symbol 112
-#define cell_type_symbol 112
-// CONSTANT cell_type_values 113
-#define cell_type_values 113
-// CONSTANT cell_type_variable 114
-#define cell_type_variable 114
-// CONSTANT cell_type_vector 115
-#define cell_type_vector 115
-// CONSTANT cell_type_broken_heart 116
-#define cell_type_broken_heart 116
-
-// CONSTANT cell_symbol_test 117
-#define cell_symbol_test 117
-
-struct function g_functions[200];
-int g_function = 0;
-
-#if !__GNUC__ || !POSIX
-#include "src/gc.mes.h"
-#include "src/hash.mes.h"
-#include "src/lib.mes.h"
-#include "src/math.mes.h"
-#include "src/mes.mes.h"
-#include "src/module.mes.h"
-#include "src/posix.mes.h"
-#include "src/reader.mes.h"
-#include "src/strings.mes.h"
-#include "src/struct.mes.h"
-#include "src/vector.mes.h"
-#else
-#include "src/gc.h"
-#include "src/hash.h"
-#include "src/lib.h"
-#include "src/math.h"
-#include "src/mes.h"
-#include "src/module.h"
-#include "src/posix.h"
-#include "src/reader.h"
-#include "src/strings.h"
-#include "src/struct.h"
-#include "src/vector.h"
-#endif
+// 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_test 118
+#define cell_test 118
+
+#include "builtins.h"
 
 #define TYPE(x) g_cells[x].type
 #define CAR(x) g_cells[x].car
@@ -484,8 +396,6 @@ int g_function = 0;
 #define CBYTES(x) &g_cells[x].cdr
 #define CSTRING_STRUCT(x) &g_cells[x.cdr].cdr
 
-#define FUNCTION(x) g_functions[g_cells[x].car]
-#define FUNCTION0(x) g_functions[g_cells[x].car].function
 #define MACRO(x) g_cells[x].car
 #define NAME(x) g_cells[x].cdr
 #define PORT(x) g_cells[x].car
@@ -502,8 +412,6 @@ int g_function = 0;
 
 #else
 #define BYTES(x) g_cells[x].bytes
-#define FUNCTION(x) g_functions[g_cells[x].function]
-#define FUNCTION0(x) g_functions[g_cells[x].function].function0
 #define LENGTH(x) g_cells[x].length
 #define REF(x) g_cells[x].ref
 #define START(x) g_cells[x].start
@@ -550,8 +458,12 @@ int g_function = 0;
 #define CADDR(x) CAR (CDR (CDR (x)))
 #define CDADAR(x) CAR (CDR (CAR (CDR (x))))
 
-SCM make_bytes (char const* s, size_t length);
+SCM apply_builtin (SCM fn, SCM x);
 SCM cstring_to_list (char const* s);
+SCM cstring_to_symbol (char const *s);
+SCM make_bytes (char const* s, size_t length);
+SCM make_hash_table_ (long size);
+SCM read_input_file_env (SCM);
 SCM string_equal_p (SCM a, SCM b);
 
 SCM
@@ -647,13 +559,6 @@ cdr_ (SCM x)
               || TYPE (CDR (x)) == TSTRING)) ? CDR (x) : MAKE_NUMBER (CDR (x));
 }
 
-SCM
-arity_ (SCM x)
-{
-  assert (TYPE (x) == TFUNCTION);
-  return MAKE_NUMBER (FUNCTION (x).arity);
-}
-
 SCM
 cons (SCM x, SCM y)
 {
@@ -806,7 +711,8 @@ check_apply (SCM f, SCM e) ///((internal))
     type = "number";
   if (TYPE (f) == TSTRING)
     type = "string";
-  if (TYPE (f) == TSTRUCT)
+  if (TYPE (f) == TSTRUCT
+      && builtin_p (f) == cell_f)
     type = "#<...>";
   if (TYPE (f) == TBROKEN_HEART)
     type = "<3";
@@ -862,7 +768,7 @@ append2 (SCM x, SCM y)
   if (x == cell_nil)
     return y;
   if (TYPE (x) != TPAIR)
-    error (cell_symbol_not_a_pair, cons (x, cell_append2));
+    error (cell_symbol_not_a_pair, cons (x, cstring_to_symbol ("append2")));
   SCM r = cell_nil;
   while (x != cell_nil)
     {
@@ -878,7 +784,7 @@ append_reverse (SCM x, SCM y)
   if (x == cell_nil)
     return y;
   if (TYPE (x) != TPAIR)
-    error (cell_symbol_not_a_pair, cons (x, cell_append_reverse));
+    error (cell_symbol_not_a_pair, cons (x, cstring_to_symbol ("append-reverse")));
   while (x != cell_nil)
     {
       y = cons (CAR (x), y);
@@ -891,7 +797,7 @@ SCM
 reverse_x_ (SCM x, SCM t)
 {
   if (x != cell_nil && TYPE (x) != TPAIR)
-    error (cell_symbol_not_a_pair, cons (x, cell_reverse_x_));
+    error (cell_symbol_not_a_pair, cons (x, cstring_to_symbol ("core:reverse!")));
   SCM r = t;
   while (x != cell_nil)
     {
@@ -914,80 +820,6 @@ pairlis (SCM x, SCM y, SCM a)
                pairlis (cdr (x), cdr (y), a));
 }
 
-SCM
-call (SCM fn, SCM x)
-{
-#if __M2_PLANET__
-  struct function *f = FUNCTION (fn);
-#else
-  struct function *f = &FUNCTION (fn);
-#endif
-  int arity = f->arity;
-  if ((arity > 0 || arity == -1)
-      && x != cell_nil && TYPE (CAR (x)) == TVALUES)
-    x = cons (CADAR (x), CDR (x));
-  if ((arity > 1 || arity == -1)
-      && x != cell_nil && TYPE (CDR (x)) == TPAIR && TYPE (CADR (x)) == TVALUES)
-    x = cons (CAR (x), cons (CDADAR (x), CDR (x)));
-
-#if __M2_PLANET__
-  FUNCTION fp = f->function;
-  if (arity == 0)
-    return fp ();
-  else if (arity == 1)
-    return fp (CAR (x));
-  else if (arity == 2)
-    return fp (CAR (x), CADR (x));
-  else if (arity == 3)
-    return fp (CAR (x), CADR (x), CAR (CDDR (x)));
-  else if (arity == -1)
-    return fp (x);
-#elif !POSIX
-  if (arity == 0)
-    {
-      //function0_t fp = f->function;
-      SCM (*fp) (void) = f->function;
-      return fp ();
-    }
-  else if (arity == 1)
-    {
-      //function1_t fp = f->function;
-      SCM (*fp) (SCM) = f->function;
-      return fp (CAR (x));
-    }
-  else if (arity == 2)
-    {
-      //function2_t fp = f->function;
-      SCM (*fp) (SCM, SCM) = f->function;
-      return fp (CAR (x), CADR (x));
-    }
-  else if (arity == 3)
-    {
-      //function3_t fp = f->function;
-      SCM (*fp) (SCM, SCM, SCM) = f->function;
-      return fp (CAR (x), CADR (x), CAR (CDDR (x)));
-    }
-  else if (arity == -1)
-    {
-      //functionn_t fp = f->function;
-      SCM (*fp) (SCM) = f->function;
-      return fp (x);
-    }
-#else
-  if (arity == 0)
-    return FUNCTION (fn).function0 ();
-  else if (arity == 1)
-    return FUNCTION (fn).function1 (CAR (x));
-  else if (arity == 2)
-    return FUNCTION (fn).function2 (CAR (x), CADR (x));
-  else if (arity == 3)
-    return FUNCTION (fn).function3 (CAR (x), CADR (x), CAR (CDDR (x)));
-  else if (arity == -1)
-    return FUNCTION (fn).functionn (x);
-#endif //! (__M2_PLANET__ || !POSIX)
-  return cell_unspecified;
-}
-
 SCM
 assq (SCM x, SCM a)
 {
@@ -1031,7 +863,7 @@ SCM
 set_car_x (SCM x, SCM e)
 {
   if (TYPE (x) != TPAIR)
-    error (cell_symbol_not_a_pair, cons (x, cell_set_car_x));
+    error (cell_symbol_not_a_pair, cons (x, cstring_to_symbol ("set-car!")));
   CAR (x) = e;
   return cell_unspecified;
 }
@@ -1040,7 +872,7 @@ SCM
 set_cdr_x (SCM x, SCM e)
 {
   if (TYPE (x) != TPAIR)
-    error (cell_symbol_not_a_pair, cons (x, cell_set_cdr_x));
+    error (cell_symbol_not_a_pair, cons (x, cstring_to_symbol ("set-cdr!")));
   CDR (x) = e;
   return cell_unspecified;
 }
@@ -1292,10 +1124,10 @@ eval_apply ()
  apply:
   g_stack_array[g_stack+FRAME_PROCEDURE] = CAR (r1);
   t = TYPE (CAR (r1));
-  if (t == TFUNCTION)
+  if (t == TSTRUCT && builtin_p (CAR (r1)) == cell_t)
     {
-      check_formals (CAR (r1), MAKE_NUMBER (FUNCTION (CAR (r1)).arity), CDR (r1));
-      r1 = call (CAR (r1), CDR (r1)); /// FIXME: move into eval_apply
+      check_formals (CAR (r1), builtin_arity (CAR (r1)), CDR (r1));
+      r1 = apply_builtin (CAR (r1), CDR (r1)); /// FIXME: move into eval_apply
       goto vm_return;
     }
   else if (t == TCLOSURE)
@@ -1817,14 +1649,6 @@ mes_g_stack (SCM a) ///((internal))
   return r0;
 }
 
-//\f Environment setup
-
-#include "src/hash.c"
-#include "src/module.c"
-#include "src/posix.c"
-#include "src/math.c"
-#include "src/lib.c"
-
 //\f Jam Collector
 SCM g_symbol_max;
 
@@ -1955,6 +1779,7 @@ mes_symbols () ///((internal))
   init_symbol (cell_symbol_wrong_type_arg, TSYMBOL, "wrong-type-arg");
 
   init_symbol (cell_symbol_buckets, TSYMBOL, "buckets");
+  init_symbol (cell_symbol_builtin, TSYMBOL, "<builtin>");
   init_symbol (cell_symbol_frame, TSYMBOL, "<frame>");
   init_symbol (cell_symbol_hashq_table, TSYMBOL, "<hashq-table>");
   init_symbol (cell_symbol_module, TSYMBOL, "<module>");
@@ -2009,7 +1834,6 @@ mes_symbols () ///((internal))
   a = acons (cell_type_char, MAKE_NUMBER (TCHAR), a);
   a = acons (cell_type_closure, MAKE_NUMBER (TCLOSURE), a);
   a = acons (cell_type_continuation, MAKE_NUMBER (TCONTINUATION), a);
-  a = acons (cell_type_function, MAKE_NUMBER (TFUNCTION), a);
   a = acons (cell_type_keyword, MAKE_NUMBER (TKEYWORD), a);
   a = acons (cell_type_macro, MAKE_NUMBER (TMACRO), a);
   a = acons (cell_type_number, MAKE_NUMBER (TNUMBER), a);
@@ -2060,194 +1884,322 @@ mes_environment (int argc, char *argv[])
 }
 
 SCM
-mes_builtins (SCM a) ///((internal))
+init_builtin (SCM builtin_type, char const* name, int arity, SCM (*function) (SCM), SCM a)
 {
-#if MES_MINI
-
-#if !POSIX
- #define function car
-#endif
-
-//mes
-scm_cons.function = g_function;
-g_functions[g_function++] = fun_cons;
-cell_cons = g_free++;
-g_cells[cell_cons] = scm_cons;
-
-scm_car.function = g_function;
-g_functions[g_function++] = fun_car;
-cell_car = g_free++;
-g_cells[cell_car] = scm_car;
-
-scm_cdr.function = g_function;
-g_functions[g_function++] = fun_cdr;
-cell_cdr = g_free++;
-g_cells[cell_cdr] = scm_cdr;
-
-scm_list.function = g_function;
-g_functions[g_function++] = fun_list;
-cell_list = g_free++;
-g_cells[cell_list] = scm_list;
-
-scm_null_p.function = g_function;
-g_functions[g_function++] = fun_null_p;
-cell_null_p = g_free++;
-g_cells[cell_null_p] = scm_null_p;
-
-scm_eq_p.function = g_function;
-g_functions[g_function++] = fun_eq_p;
-cell_eq_p = g_free++;
-g_cells[cell_eq_p] = scm_eq_p;
-
-//math
-scm_minus.function = g_function;
-g_functions[g_function++] = fun_minus;
-cell_minus = g_free++;
-g_cells[cell_minus] = scm_minus;
-
-scm_plus.function = g_function;
-g_functions[g_function++] = fun_plus;
-cell_plus = g_free++;
-g_cells[cell_plus] = scm_plus;
-
-//lib
-scm_display_.function = g_function;
-g_functions[g_function++] = fun_display_;
-cell_display_ = g_free++;
-g_cells[cell_display_] = scm_display_;
-
-scm_display_error_.function = g_function;
-g_functions[g_function++] = fun_display_error_;
-cell_display_error_ = g_free++;
-g_cells[cell_display_error_] = scm_display_error_;
-
-//posix
-scm_getenv_.function = g_function;
-g_functions[g_function++] = fun_getenv_;
-cell_getenv_ = g_free++;
-g_cells[cell_getenv_] = scm_getenv_;
-
-#if !POSIX
- #undef name
- #define string cdr
-#endif
-
-//mes.environment
-scm_cons.string = MAKE_BYTES0 (fun_cons.name);
-a = acons (cstring_to_symbol (CSTRING_STRUCT (scm_cons)), cell_cons, a);
-
-scm_car.string = MAKE_BYTES0 (fun_car.name);
-a = acons (cstring_to_symbol (CSTRING_STRUCT (scm_car)), cell_car, a);
-
-scm_cdr.string = MAKE_BYTES0 (fun_cdr.name);
-a = acons (cstring_to_symbol (CSTRING_STRUCT (scm_cdr)), cell_cdr, a);
-
-scm_list.string = MAKE_BYTES0 (fun_list.name);
-a = acons (cstring_to_symbol (CSTRING_STRUCT (scm_list)), cell_list, a);
-
-scm_null_p.string = MAKE_BYTES0 (fun_null_p.name);
-a = acons (cstring_to_symbol (CSTRING_STRUCT (scm_null_p)), cell_null_p, a);
-
-scm_eq_p.string = MAKE_BYTES0 (fun_eq_p.name);
- a = acons (cstring_to_symbol (CSTRING_STRUCT (scm_eq_p)), cell_eq_p, a);
-
-//math.environment
-scm_minus.string = MAKE_BYTES0 (fun_minus.name);
-a = acons (cstring_to_symbol (CSTRING_STRUCT (scm_minus)), cell_minus, a);
-
-scm_plus.string = MAKE_BYTES0 (fun_plus.name);
-a = acons (cstring_to_symbol (CSTRING_STRUCT (scm_plus)), cell_plus, 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);
+}
 
-//lib.environment
-scm_display_.string = MAKE_BYTES0 (fun_display_.name);
-a = acons (cstring_to_symbol (CSTRING_STRUCT (scm_display_)), cell_display_, 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_display_error_.string = MAKE_BYTES0 (fun_display_error_.name);
-a = acons (cstring_to_symbol (CSTRING_STRUCT (scm_display_error_)), cell_display_error_, a);
+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"));
+}
 
-//posix.environment
-scm_getenv_.string = MAKE_BYTES0 (fun_getenv_.name);
-a = acons (cstring_to_symbol (CSTRING_STRUCT (scm_getenv_)), cell_getenv_, a);
+SCM
+builtin_name (SCM builtin)
+{
+  return struct_ref_ (builtin, 3);
+}
 
-#if !POSIX
- #undef function
- #undef string
-#endif
+SCM
+builtin_arity (SCM builtin)
+{
+  return struct_ref_ (builtin, 4);
+}
 
-#elif !__GNUC__ || !POSIX
-#include "src/mes.mes.i"
-
-  // Do not sort: Order of these includes define builtins
-#include "src/hash.mes.i"
-#include "src/module.mes.i"
-#include "src/posix.mes.i"
-#include "src/math.mes.i"
-#include "src/lib.mes.i"
-#include "src/vector.mes.i"
-#include "src/strings.mes.i"
-#include "src/struct.mes.i"
-#include "src/gc.mes.i"
-#include "src/reader.mes.i"
-
-#include "src/gc.mes.environment.i"
-#include "src/hash.mes.environment.i"
-#include "src/lib.mes.environment.i"
-#include "src/math.mes.environment.i"
-#include "src/mes.mes.environment.i"
-#include "src/module.mes.environment.i"
-#include "src/posix.mes.environment.i"
-#include "src/reader.mes.environment.i"
-#include "src/strings.mes.environment.i"
-#include "src/struct.mes.environment.i"
-#include "src/vector.mes.environment.i"
+#if __MESC__
+long
+builtin_function (SCM builtin)
 #else
-#include "src/mes.i"
-
-  // Do not sort: Order of these includes define builtins
-#include "src/hash.i"
-#include "src/module.i"
-#include "src/posix.i"
-#include "src/math.i"
-#include "src/lib.i"
-#include "src/vector.i"
-#include "src/strings.i"
-#include "src/struct.i"
-#include "src/gc.i"
-#include "src/reader.i"
-
-#include "src/gc.environment.i"
-#include "src/hash.environment.i"
-#include "src/lib.environment.i"
-#include "src/math.environment.i"
-#include "src/mes.environment.i"
-#include "src/module.environment.i"
-#include "src/posix.environment.i"
-#include "src/reader.environment.i"
-#include "src/strings.environment.i"
-#include "src/struct.environment.i"
-#include "src/vector.environment.i"
+SCM
+(*builtin_function (SCM builtin)) (SCM)
 #endif
+{
+  return VALUE (struct_ref_ (builtin, 5));
+}
 
-  if (g_debug > 3)
+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 ", g_stdout);
+  display_ (builtin_name (builtin));
+  fdputc (" ", stdout);
+  int arity = VALUE (builtin_arity (builtin));
+  if (arity == -1)
+    fdputs ("_", g_stdout);
+  else
     {
-      fdputs ("functions: ", g_stderr);
-      fdputs (itoa (g_function), g_stderr);
-      fdputs ("\n", g_stderr);
-      for (int i = 0; i < g_function; i++)
+      fdputc ('(', g_stdout);
+      for (int i = 0; i < arity; i++)
         {
-          fdputs ("[", g_stderr);
-          fdputs (itoa (i), g_stderr);
-          fdputs ("]: ", g_stderr);
-          fdputs (g_functions[i].name, g_stderr);
-          fdputs ("\n", g_stderr);
+          if (i)
+            fdputc (' ', g_stdout);
+          fdputc ('_', g_stdout);
         }
-      fdputs ("\n", g_stderr);
     }
+  fdputc ('>', g_stdout);
+}
 
-  return a;
+SCM
+apply_builtin (SCM fn, SCM x) ///((internal))
+{
+  int arity = VALUE (builtin_arity (fn));
+  if ((arity > 0 || arity == -1)
+      && x != cell_nil && TYPE (CAR (x)) == TVALUES)
+    x = cons (CADAR (x), CDR (x));
+  if ((arity > 1 || arity == -1)
+      && x != cell_nil && TYPE (CDR (x)) == TPAIR && TYPE (CADR (x)) == TVALUES)
+    x = cons (CAR (x), cons (CDADAR (x), CDR (x)));
+
+#if __M2_PLANET__
+  FUNCTION fp = builtin_function (fn)
+  if (arity == 0)
+    return fp ();
+  else if (arity == 1)
+    return fp (CAR (x));
+  else if (arity == 2)
+    return fp (CAR (x), CADR (x));
+  else if (arity == 3)
+    return fp (CAR (x), CADR (x), CAR (CDDR (x)));
+  else if (arity == -1)
+    return fp (x);
+#elif !POSIX
+  if (arity == 0)
+    {
+      //function0_t fp = f->function;
+      SCM (*fp) (void) = builtin_function (fn);
+      return fp ();
+    }
+  else if (arity == 1)
+    {
+      //function1_t fp = f->function;
+      SCM (*fp) (SCM) = builtin_function (fn);
+      return fp (CAR (x));
+    }
+  else if (arity == 2)
+    {
+      //function2_t fp = f->function;
+      SCM (*fp) (SCM, SCM) = builtin_function (fn);
+      return fp (CAR (x), CADR (x));
+    }
+  else if (arity == 3)
+    {
+      //function3_t fp = f->function;
+      SCM (*fp) (SCM, SCM, SCM) = builtin_function (fn);
+      return fp (CAR (x), CADR (x), CAR (CDDR (x)));
+    }
+  else if (arity == -1)
+    {
+      //functionn_t fp = f->function;
+      SCM (*fp) (SCM) = builtin_function (fn);
+      return fp (x);
+    }
+#else
+  #error POSIX
+  if (arity == 0)
+    return FUNCTION (fn).function0 ();
+  else if (arity == 1)
+    return FUNCTION (fn).function1 (CAR (x));
+  else if (arity == 2)
+    return FUNCTION (fn).function2 (CAR (x), CADR (x));
+  else if (arity == 3)
+    return FUNCTION (fn).function3 (CAR (x), CADR (x), CAR (CDDR (x)));
+  else if (arity == -1)
+    return FUNCTION (fn).functionn (x);
+#endif //! (__M2_PLANET__ || !POSIX)
+  return cell_unspecified;
 }
 
-SCM read_input_file_env (SCM);
+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, &gc_check, a);
+  a = init_builtin (builtin_type, "gc", 0, &gc, a);
+  // src/hash.mes
+  a = init_builtin (builtin_type, "hashq", 2, &hashq, a);
+  a = init_builtin (builtin_type, "hash", 2, &hash, a);
+  a = init_builtin (builtin_type, "hashq-get-handle", 3, &hashq_get_handle, a);
+  a = init_builtin (builtin_type, "hashq-ref", 3, &hashq_ref, a);
+  a = init_builtin (builtin_type, "hash-ref", 3, &hash_ref, a);
+  a = init_builtin (builtin_type, "hashq-set!", 3, &hashq_set_x, a);
+  a = init_builtin (builtin_type, "hash-set!", 3, &hash_set_x, a);
+  a = init_builtin (builtin_type, "hash-table-printer", 1, &hash_table_printer, a);
+  a = init_builtin (builtin_type, "make-hash-table", 1, &make_hash_table, a);
+  // src/lib.mes
+  a = init_builtin (builtin_type, "core:display", 1, &display_, a);
+  a = init_builtin (builtin_type, "core:display-error", 1, &display_error_, a);
+  a = init_builtin (builtin_type, "core:display-port", 2, &display_port_, a);
+  a = init_builtin (builtin_type, "core:write", 1, &write_, a);
+  a = init_builtin (builtin_type, "core:write-error", 1, &write_error_, a);
+  a = init_builtin (builtin_type, "core:write-port", 2, &write_port_, a);
+  a = init_builtin (builtin_type, "exit", 1, &exit_, a);
+  a = init_builtin (builtin_type, "frame-printer", 1, &frame_printer, a);
+  a = init_builtin (builtin_type, "make-stack", -1, &make_stack, a);
+  a = init_builtin (builtin_type, "stack-length", 1, &stack_length, a);
+  a = init_builtin (builtin_type, "stack-ref", 2, &stack_ref, a);
+  a = init_builtin (builtin_type, "xassq", 2, &xassq, a);
+  a = init_builtin (builtin_type, "memq", 2, &memq, a);
+  a = init_builtin (builtin_type, "equal2?", 2, &equal2_p, a);
+  a = init_builtin (builtin_type, "last-pair", 1, &last_pair, a);
+  a = init_builtin (builtin_type, "pair?", 1, &pair_p, a);
+  // src/math.mes
+  a = init_builtin (builtin_type, ">", -1, &greater_p, a);
+  a = init_builtin (builtin_type, "<", -1, &less_p, a);
+  a = init_builtin (builtin_type, "=", -1, &is_p, a);
+  a = init_builtin (builtin_type, "-", -1, &minus, a);
+  a = init_builtin (builtin_type, "+", -1, &plus, a);
+  a = init_builtin (builtin_type, "/", -1, &divide, a);
+  a = init_builtin (builtin_type, "modulo", 2, &modulo, a);
+  a = init_builtin (builtin_type, "*", -1, &multiply, a);
+  a = init_builtin (builtin_type, "logand", -1, &logand, a);
+  a = init_builtin (builtin_type, "logior", -1, &logior, a);
+  a = init_builtin (builtin_type, "lognot", 1, &lognot, a);
+  a = init_builtin (builtin_type, "logxor", -1, &logxor, a);
+  a = init_builtin (builtin_type, "ash", 2, &ash, a);
+  // src/mes.mes
+  a = init_builtin (builtin_type, "core:make-cell", 3, &make_cell_, a);
+  a = init_builtin (builtin_type, "core:type", 1, &type_, a);
+  a = init_builtin (builtin_type, "core:car", 1, &car_, a);
+  a = init_builtin (builtin_type, "core:cdr", 1, &cdr_, a);
+  a = init_builtin (builtin_type, "cons", 2, &cons, a);
+  a = init_builtin (builtin_type, "car", 1, &car, a);
+  a = init_builtin (builtin_type, "cdr", 1, &cdr, a);
+  a = init_builtin (builtin_type, "list", -1, &list, a);
+  a = init_builtin (builtin_type, "null?", 1, &null_p, a);
+  a = init_builtin (builtin_type, "eq?", 2, &eq_p, a);
+  a = init_builtin (builtin_type, "values", -1, &values, a);
+  a = init_builtin (builtin_type, "acons", 3, &acons, a);
+  a = init_builtin (builtin_type, "length", 1, &length, a);
+  a = init_builtin (builtin_type, "error", 2, &error, a);
+  a = init_builtin (builtin_type, "append2", 2, &append2, a);
+  a = init_builtin (builtin_type, "append-reverse", 2, &append_reverse, a);
+  a = init_builtin (builtin_type, "core:reverse!", 2, &reverse_x_, a);
+  a = init_builtin (builtin_type, "pairlis", 3, &pairlis, a);
+  a = init_builtin (builtin_type, "assq", 2, &assq, a);
+  a = init_builtin (builtin_type, "assoc", 2, &assoc, a);
+  a = init_builtin (builtin_type, "set-car!", 2, &set_car_x, a);
+  a = init_builtin (builtin_type, "set-cdr!", 2, &set_cdr_x, a);
+  a = init_builtin (builtin_type, "set-env!", 3, &set_env_x, a);
+  a = init_builtin (builtin_type, "macro-get-handle", 1, &macro_get_handle, a);
+  a = init_builtin (builtin_type, "add-formals", 2, &add_formals, a);
+  a = init_builtin (builtin_type, "eval-apply", 0, &eval_apply, a);
+  a = init_builtin (builtin_type, "make-builtin-type", 0, &make_builtin_type, a);
+  a = init_builtin (builtin_type, "make-builtin", 4, &make_builtin, a);
+  a = init_builtin (builtin_type, "builtin-name", 1, &builtin_name, a);
+  a = init_builtin (builtin_type, "builtin-arity", 1, &builtin_arity, a);
+  a = init_builtin (builtin_type, "builtin?", 1, &builtin_p, a);
+  a = init_builtin (builtin_type, "builtin-printer", 1, &builtin_printer, a);
+  // src/module.mes
+  a = init_builtin (builtin_type, "make-module-type", 0, &make_module_type, a);
+  a = init_builtin (builtin_type, "module-printer", 1, &module_printer, a);
+  a = init_builtin (builtin_type, "module-variable", 2, &module_variable, a);
+  a = init_builtin (builtin_type, "module-ref", 2, &module_ref, a);
+  a = init_builtin (builtin_type, "module-define!", 3, &module_define_x, a);
+  // src/posix.mes
+  a = init_builtin (builtin_type, "peek-byte", 0, &peek_byte, a);
+  a = init_builtin (builtin_type, "read-byte", 0, &read_byte, a);
+  a = init_builtin (builtin_type, "unread-byte", 1, &unread_byte, a);
+  a = init_builtin (builtin_type, "peek-char", 0, &peek_char, a);
+  a = init_builtin (builtin_type, "read-char", -1, &read_char, a);
+  a = init_builtin (builtin_type, "unread-char", 1, &unread_char, a);
+  a = init_builtin (builtin_type, "write-char", -1, &write_char, a);
+  a = init_builtin (builtin_type, "write-byte", -1, &write_byte, a);
+  a = init_builtin (builtin_type, "getenv", 1, &getenv_, a);
+  a = init_builtin (builtin_type, "setenv", 2, &setenv_, a);
+  a = init_builtin (builtin_type, "access?", 2, &access_p, a);
+  a = init_builtin (builtin_type, "current-input-port", 0, &current_input_port, a);
+  a = init_builtin (builtin_type, "open-input-file", 1, &open_input_file, a);
+  a = init_builtin (builtin_type, "open-input-string", 1, &open_input_string, a);
+  a = init_builtin (builtin_type, "set-current-input-port", 1, &set_current_input_port, a);
+  a = init_builtin (builtin_type, "current-output-port", 0, &current_output_port, a);
+  a = init_builtin (builtin_type, "current-error-port", 0, &current_error_port, a);
+  a = init_builtin (builtin_type, "open-output-file", -1, &open_output_file, a);
+  a = init_builtin (builtin_type, "set-current-output-port", 1, &set_current_output_port, a);
+  a = init_builtin (builtin_type, "set-current-error-port", 1, &set_current_error_port, a);
+  a = init_builtin (builtin_type, "force-output", -1, &force_output, a);
+  a = init_builtin (builtin_type, "chmod", 2, &chmod_, a);
+  a = init_builtin (builtin_type, "isatty?", 1, &isatty_p, a);
+  a = init_builtin (builtin_type, "primitive-fork", 0, &primitive_fork, a);
+  a = init_builtin (builtin_type, "execl", 2, &execl_, a);
+  a = init_builtin (builtin_type, "core:waitpid", 2, &waitpid_, a);
+  a = init_builtin (builtin_type, "current-time", 0, &current_time, a);
+  a = init_builtin (builtin_type, "gettimeofday", 0, &gettimeofday_, a);
+  a = init_builtin (builtin_type, "get-internal-run-time", 0, &get_internal_run_time, a);
+  a = init_builtin (builtin_type, "getcwd", 0, &getcwd_, a);
+  a = init_builtin (builtin_type, "dup", 1, &dup_, a);
+  a = init_builtin (builtin_type, "dup2", 2, &dup2_, a);
+  a = init_builtin (builtin_type, "delete-file", 1, &delete_file, a);
+  // src/reader.mes
+  a = init_builtin (builtin_type, "core:read-input-file-env", 2, &read_input_file_env_, a);
+  a = init_builtin (builtin_type, "read-input-file-env", 1, &read_input_file_env, a);
+  a = init_builtin (builtin_type, "read-env", 1, &read_env, a);
+  a = init_builtin (builtin_type, "reader-read-sexp", 3, &reader_read_sexp, a);
+  a = init_builtin (builtin_type, "reader-read-character", 0, &reader_read_character, a);
+  a = init_builtin (builtin_type, "reader-read-binary", 0, &reader_read_binary, a);
+  a = init_builtin (builtin_type, "reader-read-octal", 0, &reader_read_octal, a);
+  a = init_builtin (builtin_type, "reader-read-hex", 0, &reader_read_hex, a);
+  a = init_builtin (builtin_type, "reader-read-string", 0, &reader_read_string, a);
+  // src/strings.mes
+  a = init_builtin (builtin_type, "string=?", 2, &string_equal_p, a);
+  a = init_builtin (builtin_type, "symbol->string", 1, &symbol_to_string, a);
+  a = init_builtin (builtin_type, "symbol->keyword", 1, &symbol_to_keyword, a);
+  a = init_builtin (builtin_type, "keyword->string", 1, &keyword_to_string, a);
+  a = init_builtin (builtin_type, "string->symbol", 1, &string_to_symbol, a);
+  a = init_builtin (builtin_type, "make-symbol", 1, &make_symbol, a);
+  a = init_builtin (builtin_type, "string->list", 1, &string_to_list, a);
+  a = init_builtin (builtin_type, "list->string", 1, &list_to_string, a);
+  a = init_builtin (builtin_type, "read-string", -1, &read_string, a);
+  a = init_builtin (builtin_type, "string-append", -1, &string_append, a);
+  a = init_builtin (builtin_type, "string-length", 1, &string_length, a);
+  a = init_builtin (builtin_type, "string-ref", 2, &string_ref, a);
+  // src/struct.mes
+  a = init_builtin (builtin_type, "make-struct", 3, &make_struct, a);
+  a = init_builtin (builtin_type, "struct-length", 1, &struct_length, a);
+  a = init_builtin (builtin_type, "struct-ref", 2, &struct_ref, a);
+  a = init_builtin (builtin_type, "struct-set!", 3, &struct_set_x, a);
+  // src/vector.mes
+  a = init_builtin (builtin_type, "core:make-vector", 1, &make_vector_, a);
+  a = init_builtin (builtin_type, "vector-length", 1, &vector_length, a);
+  a = init_builtin (builtin_type, "vector-ref", 2, &vector_ref, a);
+  a = init_builtin (builtin_type, "vector-entry", 1, &vector_entry, a);
+  a = init_builtin (builtin_type, "vector-set!", 3, &vector_set_x, a);
+  a = init_builtin (builtin_type, "list->vector", 1, &list_to_vector, a);
+  a = init_builtin (builtin_type, "vector->list", 1, &vector_to_list, a);
+
+  return a;
+}
 
 int
 load_boot (char *prefix, char const *boot, char const *location)
@@ -2317,11 +2269,16 @@ load_env () ///((internal))
   return r2;
 }
 
-#include "src/vector.c"
-#include "src/strings.c"
-#include "src/struct.c"
-#include "src/gc.c"
-#include "src/reader.c"
+#include "hash.c"
+#include "module.c"
+#include "posix.c"
+#include "math.c"
+#include "lib.c"
+#include "vector.c"
+#include "strings.c"
+#include "struct.c"
+#include "gc.c"
+#include "reader.c"
 
 int
 main (int argc, char *argv[])
index 773e1793eb4706e620fdcceb552d569dcb37ea8f..79c43dfd490b45ea186402c8a50ff53a0d0c8c22 100644 (file)
@@ -53,7 +53,7 @@ make_initial_module (SCM a) ///((internal))
   values = cons (locals, values);
   values = cons (name, 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 = cons (CADR (a), r0);
   r0 = cons (CAR (a), r0);
index 0460729d3e5f4a666c87a186092cf8cdfe71b760..dea9fdc281efe3bf340ac806ade84f54941bfba0 100644 (file)
  * 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
 make_struct (SCM type, SCM fields, SCM printer)
 {