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

core+mini-mes: Move function name to struct function.

Browse source 
* 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 2017-03-09 23:27:12 +01:00
parent e9560e95a5
commit f612feec47
5 changed files with 46 additions and 101 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
build-aux/mes-snarf.scm
View file

@ -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
View file

@ -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;

16
module/language/c99/compiler.mes
View file

@ -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

73
scaffold/cons-mes.c
View file

@ -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;
}

45
scaffold/mini-mes.c
View file

@ -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);