From f612feec474e5c45a9453d00132e3f6a2f7acc0d Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Thu, 9 Mar 2017 23:27:12 +0100 Subject: [PATCH] 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. --- build-aux/mes-snarf.scm | 10 ++--- mes.c | 3 +- module/language/c99/compiler.mes | 16 +++++-- scaffold/cons-mes.c | 73 +++----------------------------- scaffold/mini-mes.c | 45 +++++++++----------- 5 files changed, 46 insertions(+), 101 deletions(-) diff --git a/build-aux/mes-snarf.scm b/build-aux/mes-snarf.scm index dda015e2..d79f7e38 100755 --- a/build-aux/mes-snarf.scm +++ b/build-aux/mes-snarf.scm @@ -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)))) diff --git a/mes.c b/mes.c index 00d6244c..f0bcc6c1 100644 --- a/mes.c +++ b/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; diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes index 7a55c03d..c4cbeb8b 100644 --- a/module/language/c99/compiler.mes +++ b/module/language/c99/compiler.mes @@ -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 diff --git a/scaffold/cons-mes.c b/scaffold/cons-mes.c index c579988c..d500914b 100644 --- a/scaffold/cons-mes.c +++ b/scaffold/cons-mes.c @@ -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; } diff --git a/scaffold/mini-mes.c b/scaffold/mini-mes.c index 047cba43..979ac177 100644 --- a/scaffold/mini-mes.c +++ b/scaffold/mini-mes.c @@ -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);