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.

diff --git a/build-aux/mes-snarf.scm b/build-aux/mes-snarf.scm
index dda015e20b212971d384bb57aace36372a1c6c52..d79f7e3881fdb034d6ee58e98bf8b7ff87a8fed9 100755 (executable)
--- 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 00d6244c34e5e72974c6e6f406767c6afa42696f..f0bcc6c19ab5dda128d4f171121531025fd92cc4 100644 (file)
--- 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 7a55c03de77921c7f8f0a1bfd746b86f90b1919b..c4cbeb8b0066ff387cdfa8233ff534d93dcb5b90 100644 (file)
--- 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 c579988c1cd649d40e66a113b31fee031cd848f6..d500914be81a34418b8cd3e9ea25087f2601b10b 100644 (file)
--- 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 047cba4388012eb261b2545d2bc4845fa365cd2b..979ac177c928e8c6c18c559ab8c9d25ccc5b2e89 100644 (file)
--- 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);