mescc: Support generic initializer.

* module/language/c99/compiler.mes (ast->info): Support generic
  declaration using initializer.  Supports struct field initializer.
* doc/examples/t.c (struct_test): Test it.
* doc/examples/mini-mes.c (call_lambda, eval_apply, write_byte,
  display_): Use it.  (call_lambda): (eval_apply,
  list_of_char_equal_p): Use it.

diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes
index d8e202692467287bc4d65759726696c95afb5e09..455015b7f289a9e7e20639cc9f981272c28f4a79 100644 (file)
--- a/module/language/c99/compiler.mes
+++ b/module/language/c99/compiler.mes
@@ -991,6 +991,9 @@ _)))))
                                clause-text)
                   #:globals (.globals clause-info)))))
 
+      ((case (neg (p-expr (fixed ,value))) ,statement)
+       ((case->jump-info info) `(case (p-expr (fixed ,(string-append "-" value))) ,statement)))
+
       ((default (compd-stmt (block-item-list . ,elements)))
        (lambda (body-length)
          (let ((text-length (length (.text info))))
@@ -1812,18 +1815,6 @@ _)))))
                               ((ident->accu info) local)
                               ((accu->ident info) name))))))
 
-        ;; int i = f ();
-        ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (fctn-call . ,call)))))
-         ;;(stderr  "4TYPE: ~s\n" type)
-         (let* ((locals (add-local locals name type 0))
-                (info (clone info #:locals locals)))
-           (let ((info ((ast->info info) `(expr-stmt (fctn-call ,@call)))))
-             (clone info
-                    #:text
-                    (append (.text info)
-                            ((accu->ident info) name))
-                    #:locals locals))))
-        
         ;; int (*function) (void) = g_functions[g_cells[fn].cdr].function;
         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,param-list)) (initzer ,initzer))))
          (let* ((locals (add-local locals name type 1))
@@ -1843,17 +1834,6 @@ _)))))
                                    (i386:accu+base)))))
                   #:locals locals)))
 
-        ;; SCM x = car (e);
-        ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name) (initzer (fctn-call . ,call)))))
-         ;;(stderr  "5TYPE: ~s\n" type)
-         (let* ((locals (add-local locals name type 0))
-                (info (clone info #:locals locals)))
-           (let ((info ((ast->info info) `(expr-stmt (fctn-call ,@call)))))
-             (clone info
-                    #:text
-                    (append (.text info)
-                            ((accu->ident info) name))))))
-
         ;; char *p = (char*)g_cells;
         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (cast (type-name (decl-spec-list (type-spec (fixed-type ,=type))) (abs-declr (pointer))) (p-expr (ident ,value)))))))
          ;;(stderr  "6TYPE: ~s\n" type)
@@ -1893,8 +1873,7 @@ _)))))
                                 ((ident->accu info) value)
                                 ((accu->ident info) name))))
                (let* ((globals (append globals (list (ident->global name type 1 0))))
-                      (here (data-offset name globals))
-                      (there (data-offset value globals)))
+                      (here (data-offset name globals)))
                  (clone info
                         #:globals globals
                         #:init (append (.init info)
@@ -1904,8 +1883,6 @@ _)))))
                                               ;;; FIXME: type
                                               ;;; char *x = arena;p
                                                 (int->bv32 (+ d (data-offset value globals)))
-                                              ;;; char *y = x;
-                                              ;;;(list-head (list-tail data there) 4)
                                                 (list-tail data (+ here 4)))))))))))
 
         ;; enum 
@@ -2205,9 +2182,34 @@ _)))))
                                                 (initzer->data info functions globals ta t d (car initzers))
                                                 (list-tail data (+ here offset field-size)))))))))))))))
 
+
+        ;;char cc = g_cells[c].cdr;  ==> generic?
+        ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ident ,name) (initzer ,initzer))))
+         (let ((type (decl->type type)))
+           (if (.function info)
+               (let* ((locals (add-local locals name type 0))
+                      (info (clone info #:locals locals)))
+                 (clone info #:text
+                        (append (.text ((expr->accu info) initzer))
+                                ((accu->ident info) name))))
+               (let* ((globals (append globals (list (ident->global name type 1 0))))
+                      (here (data-offset name globals)))
+                 (clone info
+                        #:globals globals
+                        #:init (append (.init info)
+                                       (list (lambda (functions globals ta t d data)
+                                               (append
+                                                (list-head data here)
+                                                (initzer->data info functions globals ta t d initzer)
+                                                (list-tail data (+ here 4)))))))))))
+
+
         ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))))
          info)
 
+        ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))) (comment ,comment))
+         info)
+
         ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name))))
          (let ((types (.types info)))
            (clone info #:types (cons (cons name (assoc-ref types type)) types))))

diff --git a/scaffold/mini-mes.c b/scaffold/mini-mes.c
index fed25893727f63dd7d3c5ae5bf85fdd5d35483ab..b79ef163df8a1e5f54a8d5a759659db08d2e4b1a 100644 (file)
--- a/scaffold/mini-mes.c
+++ b/scaffold/mini-mes.c
@@ -251,10 +251,7 @@ assert_fail (char* s)
 
 typedef int SCM;
 
-#if __GNUC__
 int g_debug = 0;
-#endif
-
 int g_free = 0;
 
 SCM g_continuations = 0;
@@ -560,10 +557,7 @@ SCM
 append2 (SCM x, SCM y)
 {
   if (x == cell_nil) return y;
-#if __GNUC__
-  //FIXME GNUC
   assert (TYPE (x) == TPAIR);
-#endif
   return cons (car (x), append2 (cdr (x), y));
 }
 
@@ -578,10 +572,7 @@ pairlis (SCM x, SCM y, SCM a)
                pairlis (cdr (x), cdr (y), a));
 }
 
-
-#if __GNUC__
 SCM display_ (SCM);
-#endif
 
 SCM
 call (SCM fn, SCM x)
@@ -594,19 +585,11 @@ call (SCM fn, SCM x)
     x = cons (CAR (x), cons (CDADAR (x), CDR (x)));
   switch (FUNCTION (fn).arity)
     {
-    // case 0: return FUNCTION (fn).function0 ();
-    // case 1: return FUNCTION (fn).function1 (car (x));
-    // case 2: return FUNCTION (fn).function2 (car (x), cadr (x));
-    // case 3: return FUNCTION (fn).function3 (car (x), cadr (x), car (cddr (x)));
-    // case -1: return FUNCTION (fn).functionn (x);
     case 0: {return (FUNCTION (fn).function) ();}
     case 1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (car (x));}
     case 2: {return ((SCM(*)(SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x));}
     case 3: {return ((SCM(*)(SCM,SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x), car (cddr (x)));}
-#if __GNUC__
-      // FIXME GNUC
     case -1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);}
-#endif
     default: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);}
     }
 
@@ -657,9 +640,7 @@ set_env_x (SCM x, SCM e, SCM a)
 SCM
 call_lambda (SCM e, SCM x, SCM aa, SCM a) ///((internal))
 {
-  //FIXME
-  //SCM cl = cons (cons (cell_closure, x), x);
-  SCM cl;
+  SCM cl = cons (cons (cell_closure, x), x);
   cl = cons (cons (cell_closure, x), x);
   r1 = e;
   r0 = cl;
@@ -699,10 +680,7 @@ SCM cadr (SCM x) {return car (cdr (x));}
 SCM cdar (SCM x) {return cdr (car (x));}
 SCM cddr (SCM x) {return cdr (cdr (x));}
 
-#if __GNUC__
-//FIXME
 SCM gc_pop_frame (); //((internal))
-#endif
 
 SCM
 eval_apply ()
@@ -765,10 +743,7 @@ eval_apply ()
     }
     case TCLOSURE:
       {
-        //FIXME
-        //SCM cl = CLOSURE (car (r1));
-        SCM cl;
-        cl = CLOSURE (car (r1));
+        SCM cl = CLOSURE (car (r1));
         SCM formals = cadr (cl);
         SCM body = cddr (cl);
         SCM aa = cdar (cl);
@@ -1087,12 +1062,7 @@ SCM
 make_symbol_ (SCM s)
 {
   VALUE (tmp_num) = TSYMBOL;
-  ///FIXME SCM x = make_cell (tmp_num, s, 0);
-  SCM x;
-  x = make_cell (tmp_num, s, 0);
-  puts ("MAKE SYMBOL: ");
-  display_ (x);
-  puts ("\n");
+  SCM x = make_cell (tmp_num, s, 0);
   g_symbols = cons (x, g_symbols);
   return x;
 }
@@ -1178,10 +1148,7 @@ write_byte (SCM x) ///((arity . n))
   //FILE *f = fd == 1 ? stdout : stderr;
   assert (TYPE (c) == TNUMBER || TYPE (c) == TCHAR);
   //  fputc (VALUE (c), f);
-  // FIXME
-  //char cc = VALUE (c);
-  char cc;
-  cc = VALUE (c);
+  char cc = VALUE (c);
   write (1, (char*)&cc, fd);
   return c;
 }
@@ -1252,10 +1219,7 @@ display_ (SCM x)
       }
     case TSYMBOL:
       {
-        // FIXME
-        ///SCM t = CAR (x);
-        SCM t;
-        t = CAR (x);
+        SCM t = CAR (x);
         while (t != cell_nil)
           {
             putchar (VALUE (CAR (t)));
@@ -1461,16 +1425,6 @@ int
 main (int argc, char *argv[])
 {
   eputs ("Hello mini-mes!\n");
-
-  // make_tmps (g_cells);
-  // SCM x = cstring_to_list ("bla");
-  // while (x != 1)
-  //   {
-  //     putchar (CDR (CAR (x)));
-  //     x = CDR (x);
-  //   }
-  // return 0;
-
 #if __GNUC__
   //g_debug = getenv ("MES_DEBUG");
 #endif
@@ -1505,14 +1459,12 @@ main (int argc, char *argv[])
 #if !MES_MINI
   gc (g_stack);
 #endif
-#if __GNUC__
   if (g_debug)
     {
       eputs ("\nstats: [");
       eputs (itoa (g_free));
       eputs ("]\n");
     }
-#endif
   return 0;
 }
 

diff --git a/scaffold/t.c b/scaffold/t.c
index 8f9fa807d95b6321a1487c5e5dbb7bad4d153698..f19d29339bcf0a206c26270186197ded5745a79c 100644 (file)
--- a/scaffold/t.c
+++ b/scaffold/t.c
@@ -327,6 +327,10 @@ struct_test ()
   g_cells[0].car = 1;
   g_cells[1].car = 2;
 
+  puts ("t: int c = VALUE (0)\n");
+  int c = CAR (0);
+  if (c != 1) return 1;
+
   puts ("t: CAAR (0) != 2\n");
   if (CAAR (0) != 2) return 1;