core+mini-mes: Move function name to struct function.
* module/language/c99/compiler.mes (expr->arg): Handle char arguments. * doc/examples/cons-mes.c (struct function): Add name field. * doc/examples/mini-mes.c: Likewise. (mes_builtins): Update. * mes.c: Likewise. * build-aux/mes-snarf.scm: Update.
This commit is contained in:
Jan Nieuwenhuizen
parent
e9560e95a5
commit
f612feec47
|
|
@ -94,11 +94,11 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e
|
|||
(string-append
|
||||
(format #f "SCM ~a (~a);\n" (.name f) (.formals f))
|
||||
(if GCC?
|
||||
(format #f "function_t fun_~a = {.function~a=&~a, .arity=~a};\n" (.name f) arity (.name f) n)
|
||||
(format #f "function_t fun_~a = {&~a, ~a};\n" (.name f) (.name f) n))
|
||||
(format #f "function_t fun_~a = {.function~a=&~a, .arity=~a, .name=~s};\n" (.name f) arity (.name f) n (function-scm-name f))
|
||||
(format #f "function_t fun_~a = {&~a, ~a, ~s};\n" (.name f) (.name f) n (function-scm-name f)))
|
||||
(if GCC?
|
||||
(format #f "scm ~a = {FUNCTION, .name=~S, .function=0};\n" (function-builtin-name f) (function-scm-name f))
|
||||
(format #f "scm ~a = {FUNCTION, ~S, 0};\n" (function-builtin-name f) (function-scm-name f)))
|
||||
(format #f "scm ~a = {FUNCTION, .name=0, .function=0};\n" (function-builtin-name f))
|
||||
(format #f "scm ~a = {FUNCTION, 0, 0};\n" (function-builtin-name f)))
|
||||
(format #f "SCM cell_~a;\n\n" (.name f)))))
|
||||
|
||||
(define (function->source f i)
|
||||
|
|
@ -110,7 +110,7 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e
|
|||
|
||||
(define (function->environment f i)
|
||||
(string-append
|
||||
(format #f "scm_~a.string = cstring_to_list (scm_~a.name);\n" (.name f) (.name f))
|
||||
(format #f "scm_~a.string = cstring_to_list (fun_~a.name);\n" (.name f) (.name f))
|
||||
(format #f "g_cells[cell_~a].string = MAKE_STRING (scm_~a.string);\n" (.name f) (.name f))
|
||||
(format #f "a = acons (make_symbol (scm_~a.string), ~a, a);\n\n" (.name f) (function-cell-name f))))
|
||||
|
||||
|
|
|
|||
3
mes.c
3
mes.c
|
|
@ -61,12 +61,13 @@ typedef struct function_struct {
|
|||
functionn_t functionn;
|
||||
} NYACC;
|
||||
int arity;
|
||||
char const *name;
|
||||
} function_t;
|
||||
struct scm;
|
||||
typedef struct scm_struct {
|
||||
enum type_t type;
|
||||
union {
|
||||
char const *name;
|
||||
char const* name;
|
||||
SCM string;
|
||||
SCM car;
|
||||
SCM ref;
|
||||
|
|
|
|||
|
|
@ -318,6 +318,16 @@
|
|||
(list (lambda (f g ta t d)
|
||||
(i386:push-accu)))))))
|
||||
|
||||
|
||||
((p-expr (char ,char))
|
||||
(let ((char (char->integer (car (string->list char)))))
|
||||
(clone info
|
||||
#:text (append text
|
||||
(list (lambda (f g ta t d)
|
||||
(append
|
||||
(i386:value->accu char)
|
||||
(i386:push-accu)))))))
|
||||
)
|
||||
;; f (0 + x)
|
||||
;;; aargh
|
||||
;;;((add (p-expr (fixed ,value)) (d-sel (ident cdr) (array-ref (p-expr (ident x)) (p-expr (ident g_cells))))))
|
||||
|
|
@ -593,12 +603,12 @@
|
|||
(list (lambda (f g ta t d)
|
||||
(i386:value->accu value)))))))
|
||||
|
||||
((p-expr (char ,value))
|
||||
(let ((value (char->integer (car (string->list value)))))
|
||||
((p-expr (char ,char))
|
||||
(let ((char (char->integer (car (string->list char)))))
|
||||
(clone info #:text
|
||||
(append text
|
||||
(list (lambda (f g ta t d)
|
||||
(i386:value->accu value)))))))
|
||||
(i386:value->accu char)))))))
|
||||
|
||||
((p-expr (ident ,name))
|
||||
(clone info #:text
|
||||
|
|
|
|||
|
|
@ -273,6 +273,7 @@ typedef int (*f_t) (void);
|
|||
struct function {
|
||||
int (*function) (void);
|
||||
int arity;
|
||||
char *name;
|
||||
};
|
||||
|
||||
struct scm *g_cells = arena;
|
||||
|
|
@ -344,7 +345,7 @@ int g_function = 0;
|
|||
//FIXME
|
||||
SCM make_cell (SCM type, SCM car, SCM cdr);
|
||||
#endif
|
||||
struct function fun_make_cell = {&make_cell, 3};
|
||||
struct function fun_make_cell = {&make_cell,3,"make-cell"};
|
||||
struct scm scm_make_cell = {TFUNCTION,0,0};
|
||||
//, "make-cell", 0};
|
||||
SCM cell_make_cell;
|
||||
|
|
@ -353,7 +354,7 @@ SCM cell_make_cell;
|
|||
//FIXME
|
||||
SCM cons (SCM x, SCM y);
|
||||
#endif
|
||||
struct function fun_cons = {&cons, 2};
|
||||
struct function fun_cons = {&cons,2,"cons"};
|
||||
struct scm scm_cons = {TFUNCTION,0,0};
|
||||
// "cons", 0};
|
||||
SCM cell_cons;
|
||||
|
|
@ -362,7 +363,7 @@ SCM cell_cons;
|
|||
//FIXME
|
||||
SCM car (SCM x);
|
||||
#endif
|
||||
struct function fun_car = {&car, 1};
|
||||
struct function fun_car = {&car,1,"car"};
|
||||
struct scm scm_car = {TFUNCTION,0,0};
|
||||
// "car", 0};
|
||||
SCM cell_car;
|
||||
|
|
@ -371,14 +372,14 @@ SCM cell_car;
|
|||
//FIXME
|
||||
SCM cdr (SCM x);
|
||||
#endif
|
||||
struct function fun_cdr = {&cdr, 1};
|
||||
struct function fun_cdr = {&cdr,1,"cdr"};
|
||||
struct scm scm_cdr = {TFUNCTION,0,0};
|
||||
// "cdr", 0};
|
||||
SCM cell_cdr;
|
||||
|
||||
// SCM eq_p (SCM x, SCM y);
|
||||
// struct function fun_eq_p = {&eq_p, 2};
|
||||
// scm scm_eq_p = {TFUNCTION,0,0};// "eq?", 0};
|
||||
// struct function fun_eq_p = {&eq_p,2,"eq?"};
|
||||
// scm scm_eq_p = {TFUNCTION,0,0};
|
||||
// SCM cell_eq_p;
|
||||
|
||||
#define TYPE(x) (g_cells[x].type)
|
||||
|
|
@ -715,16 +716,6 @@ make_symbol (SCM s)
|
|||
return x ? x : make_symbol_ (s);
|
||||
}
|
||||
|
||||
SCM
|
||||
cstring_to_list (char const* s)
|
||||
{
|
||||
SCM p = cell_nil;
|
||||
int i = strlen (s);
|
||||
while (i--)
|
||||
p = cons (MAKE_CHAR (s[i]), p);
|
||||
return p;
|
||||
}
|
||||
|
||||
SCM
|
||||
acons (SCM key, SCM value, SCM alist)
|
||||
{
|
||||
|
|
@ -738,18 +729,6 @@ SCM
|
|||
gc_init_cells ()
|
||||
{
|
||||
return 0;
|
||||
// g_cells = (scm *)malloc (2*ARENA_SIZE*sizeof(scm));
|
||||
|
||||
// #if __NYACC__ || FIXME_NYACC
|
||||
// TYPE (0) = TVECTOR;
|
||||
// // #else
|
||||
// // TYPE (0) = VECTOR;
|
||||
// #endif
|
||||
// LENGTH (0) = 1000;
|
||||
// VECTOR (0) = 0;
|
||||
// g_cells++;
|
||||
// TYPE (0) = CHAR;
|
||||
// VALUE (0) = 'c';
|
||||
}
|
||||
|
||||
// INIT NEWS
|
||||
|
|
@ -831,31 +810,10 @@ g_free++;
|
|||
|
||||
SCM a = cell_nil;
|
||||
|
||||
#if __GNUC__ && 0
|
||||
//#include "mes.symbol-names.i"
|
||||
#else
|
||||
// g_cells[cell_nil].car = cstring_to_list (scm_nil.name);
|
||||
// g_cells[cell_f].car = cstring_to_list (scm_f.name);
|
||||
// g_cells[cell_t].car = cstring_to_list (scm_t.name);
|
||||
// g_cells[cell_dot].car = cstring_to_list (scm_dot.name);
|
||||
// g_cells[cell_arrow].car = cstring_to_list (scm_arrow.name);
|
||||
// g_cells[cell_undefined].car = cstring_to_list (scm_undefined.name);
|
||||
// g_cells[cell_unspecified].car = cstring_to_list (scm_unspecified.name);
|
||||
// g_cells[cell_closure].car = cstring_to_list (scm_closure.name);
|
||||
// g_cells[cell_circular].car = cstring_to_list (scm_circular.name);
|
||||
// g_cells[cell_begin].car = cstring_to_list (scm_begin.name);
|
||||
#endif
|
||||
|
||||
// a = acons (cell_symbol_mes_version, MAKE_STRING (cstring_to_list (VERSION)), a);
|
||||
// a = acons (cell_symbol_mes_prefix, MAKE_STRING (cstring_to_list (PREFIX)), a);
|
||||
|
||||
a = acons (cell_symbol_dot, cell_dot, a);
|
||||
a = acons (cell_symbol_begin, cell_begin, a);
|
||||
a = acons (cell_closure, a, a);
|
||||
|
||||
// a = acons (cell_symbol_call_with_current_continuation, cell_call_with_current_continuation, a);
|
||||
// a = acons (cell_symbol_sc_expand, cell_f, a);
|
||||
|
||||
return a;
|
||||
}
|
||||
|
||||
|
|
@ -892,7 +850,6 @@ mes_builtins (SCM a)
|
|||
// #include "posix.environment.i"
|
||||
// #include "reader.environment.i"
|
||||
#else
|
||||
|
||||
scm_make_cell.cdr = g_function;
|
||||
g_functions[g_function++] = fun_make_cell;
|
||||
cell_make_cell = g_free++;
|
||||
|
|
@ -912,22 +869,6 @@ scm_cdr.cdr = g_function;
|
|||
g_functions[g_function++] = fun_cdr;
|
||||
cell_cdr = g_free++;
|
||||
g_cells[cell_cdr] = scm_cdr;
|
||||
|
||||
// scm_make_cell.string = cstring_to_list (scm_make_cell.name);
|
||||
// g_cells[cell_make_cell].string = MAKE_STRING (scm_make_cell.string);
|
||||
// a = acons (make_symbol (scm_make_cell.string), cell_make_cell, a);
|
||||
|
||||
// scm_cons.string = cstring_to_list (scm_cons.name);
|
||||
// g_cells[cell_cons].string = MAKE_STRING (scm_cons.string);
|
||||
// a = acons (make_symbol (scm_cons.string), cell_cons, a);
|
||||
|
||||
// scm_car.string = cstring_to_list (scm_car.name);
|
||||
// g_cells[cell_car].string = MAKE_STRING (scm_car.string);
|
||||
// a = acons (make_symbol (scm_car.string), cell_car, a);
|
||||
|
||||
// scm_cdr.string = cstring_to_list (scm_cdr.name);
|
||||
// g_cells[cell_cdr].string = MAKE_STRING (scm_cdr.string);
|
||||
// a = acons (make_symbol (scm_cdr.string), cell_cdr, a);
|
||||
#endif
|
||||
return a;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -284,6 +284,7 @@ typedef int (*f_t) (void);
|
|||
struct function {
|
||||
int (*function) (void);
|
||||
int arity;
|
||||
char *name;
|
||||
};
|
||||
|
||||
struct scm *g_cells = arena;
|
||||
|
|
@ -384,49 +385,32 @@ int g_function = 0;
|
|||
//FIXME
|
||||
SCM make_cell (SCM type, SCM car, SCM cdr);
|
||||
#endif
|
||||
struct function fun_make_cell = {&make_cell, 3};
|
||||
|
||||
#if 1
|
||||
struct scm scm_make_cell = {TFUNCTION,"make-cell",0};
|
||||
#else
|
||||
struct function fun_make_cell = {&make_cell,3,"make-cell"};
|
||||
struct scm scm_make_cell = {TFUNCTION,0,0};
|
||||
#endif
|
||||
SCM cell_make_cell;
|
||||
|
||||
#if __GNUC__
|
||||
//FIXME
|
||||
SCM cons (SCM x, SCM y);
|
||||
#endif
|
||||
struct function fun_cons = {&cons, 2};
|
||||
#if __GNUC__
|
||||
struct scm scm_cons = {TFUNCTION,"cons",0};
|
||||
#else
|
||||
struct function fun_cons = {&cons,2,"cons"};
|
||||
struct scm scm_cons = {TFUNCTION,0,0};
|
||||
#endif
|
||||
SCM cell_cons;
|
||||
|
||||
#if __GNUC__
|
||||
//FIXME
|
||||
SCM car (SCM x);
|
||||
#endif
|
||||
struct function fun_car = {&car, 1};
|
||||
#if __GNUC__
|
||||
struct scm scm_car = {TFUNCTION,"car",0};
|
||||
#else
|
||||
struct function fun_car = {&car,1,"car"};
|
||||
struct scm scm_car = {TFUNCTION,0,0};
|
||||
#endif
|
||||
SCM cell_car;
|
||||
|
||||
#if __GNUC__
|
||||
//FIXME
|
||||
SCM cdr (SCM x);
|
||||
#endif
|
||||
struct function fun_cdr = {&cdr, 1};
|
||||
#if __GNUC__
|
||||
struct scm scm_cdr = {TFUNCTION,"cdr",0};
|
||||
#else
|
||||
struct function fun_cdr = {&cdr,1,"cdr"};
|
||||
struct scm scm_cdr = {TFUNCTION,0,0};
|
||||
#endif
|
||||
SCM cell_cdr;
|
||||
|
||||
// SCM eq_p (SCM x, SCM y);
|
||||
|
|
@ -1229,10 +1213,19 @@ make_symbol (SCM s)
|
|||
SCM
|
||||
cstring_to_list (char const* s)
|
||||
{
|
||||
char *x = s;
|
||||
SCM p = cell_nil;
|
||||
int i = strlen (s);
|
||||
while (i--)
|
||||
p = cons (MAKE_CHAR (s[i]), p);
|
||||
{
|
||||
#if 0
|
||||
//FIXME
|
||||
p = cons (MAKE_CHAR (s[i]), p);
|
||||
#else
|
||||
p = cons (MAKE_CHAR (*x), p);
|
||||
x++;
|
||||
#endif
|
||||
}
|
||||
return p;
|
||||
}
|
||||
|
||||
|
|
@ -1438,7 +1431,7 @@ g_cells[cell_cdr] = scm_cdr;
|
|||
//g_cells[cell_make_cell].string = MAKE_STRING (scm_make_cell.string);
|
||||
//a = acons (make_symbol (scm_make_cell.string), cell_make_cell, a);
|
||||
puts ("00\n");
|
||||
scm_make_cell.car = cstring_to_list (scm_make_cell.car);
|
||||
scm_make_cell.car = cstring_to_list (fun_make_cell.name);
|
||||
puts ("01\n");
|
||||
g_cells[cell_make_cell].car = MAKE_STRING (scm_make_cell.car);
|
||||
puts ("02\n");
|
||||
|
|
@ -1448,21 +1441,21 @@ g_cells[cell_make_cell].car = MAKE_STRING (scm_make_cell.car);
|
|||
//scm_cons.string = cstring_to_list (scm_cons.name);
|
||||
//g_cells[cell_cons].string = MAKE_STRING (scm_cons.string);
|
||||
//a = acons (make_symbol (scm_cons.string), cell_cons, a);
|
||||
scm_cons.car = cstring_to_list (scm_cons.car);
|
||||
scm_cons.car = cstring_to_list (fun_cons.name);
|
||||
g_cells[cell_cons].car = MAKE_STRING (scm_cons.car);
|
||||
a = acons (make_symbol (scm_cons.car), cell_cons, a);
|
||||
|
||||
//scm_car.string = cstring_to_list (scm_car.name);
|
||||
//g_cells[cell_car].string = MAKE_STRING (scm_car.string);
|
||||
//a = acons (make_symbol (scm_cons.string), cell_cons, a);
|
||||
scm_car.car = cstring_to_list (scm_car.car);
|
||||
scm_car.car = cstring_to_list (fun_car.name);
|
||||
g_cells[cell_car].car = MAKE_STRING (scm_car.car);
|
||||
a = acons (make_symbol (scm_cons.car), cell_cons, a);
|
||||
|
||||
//scm_cdr.string = cstring_to_list (scm_cdr.name);
|
||||
//g_cells[cell_cdr].string = MAKE_STRING (scm_cdr.string);
|
||||
//a = acons (make_symbol (scm_cdr.string), cell_cdr, a);
|
||||
scm_cdr.car = cstring_to_list (scm_cdr.car);
|
||||
scm_cdr.car = cstring_to_list (fun_cdr.name);
|
||||
g_cells[cell_cdr].car = MAKE_STRING (scm_cdr.car);
|
||||
a = acons (make_symbol (scm_cdr.car), cell_cdr, a);
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue