mini-mes: Update display_.

* doc/examples/mini-mes.c (display_): Add separator, nicer recursion.
* mes.c (display_): Update.

diff --git a/mes.c b/mes.c
index 880a02ba220f116b4b0eae565134074d7c39442b..fa794b87be8c192cbcf2bc28e2ce611809ac71e8 100644 (file)
--- a/mes.c
+++ b/mes.c
@@ -1024,63 +1024,91 @@ string_to_cstring (SCM s)
   return buf;
 }
 
+int g_depth;
+
+#define gputs(x) fputs(x, stdout)
+
 SCM
-display_ (SCM x)
+display_helper (SCM x, int cont, char* sep)
 {
+  gputs (sep);
+  if (g_depth == 0) return cell_unspecified;
+  //FIXME:
+  //g_depth--;
+  g_depth = g_depth - 1;
+  
   // eputs ("<display>\n");
   switch (TYPE (x))
     {
     case TCHAR:
       {
-        //fputs ("<char>\n", stdout);
-        fputs ("#\\", stdout);
+        //puts ("<char>\n");
+        gputs ("#\\");
         putchar (VALUE (x));
         break;
       }
     case TFUNCTION:
       {
-        fputs ("#<procedure ", stdout);
-        ///fputs (FUNCTION (x).name ? FUNCTION (x).name : "?", stdout);
+        gputs ("#<procedure ");
+        ///gputs (FUNCTION (x).name ? FUNCTION (x).name : "?");
         char *p = "?";
         if (FUNCTION (x).name != 0)
           p = FUNCTION (x).name;
-        fputs (p, stdout);
-        fputs ("[", stdout);
-        fputs (itoa (CDR (x)), stdout);
-        fputs ("]>", stdout);
+        gputs (p);
+        gputs ("[");
+        gputs (itoa (CDR (x)));
+        gputs (",");
+        gputs (itoa (x));
+        gputs ("]>");
         break;
       }
     case TMACRO:
       {
-        fputs ("#<macro ", 1);
-        display_ (cdr (x));
-        fputs (">", 1);
+        gputs ("#<macro ");
+        display_helper (cdr (x), cont, "");
+        gputs (">");
         break;
       }
     case TNUMBER:
       {
-        //fputs ("<number>\n", stdout);
-        fputs (itoa (VALUE (x)), stdout);
+        //gputs ("<number>\n");
+        gputs (itoa (VALUE (x)));
         break;
       }
     case TPAIR:
       {
-        //fputs ("<pair>\n", stdout);
-        //if (cont != cell_f) fputs ("(", stdout);
-        fputs ("(", stdout);
+        if (!cont) gputs ("(");
         if (x && x != cell_nil) display_ (CAR (x));
-        if (CDR (x) && CDR (x) != cell_nil)
+        if (CDR (x) && TYPE (CDR (x)) == TPAIR)
+          display_helper (CDR (x), 1, " ");
+        else if (CDR (x) && CDR (x) != cell_nil)
           {
             if (TYPE (CDR (x)) != TPAIR)
-              fputs (" . ", stdout);
+              gputs (" . ");
             display_ (CDR (x));
           }
-        //if (cont != cell_f) fputs (")", stdout);
-        fputs (")", stdout);
+        if (!cont) gputs (")");
         break;
       }
     case TSPECIAL:
+#if __NYACC__
+      // FIXME
+      //{}
+      {
+        SCM t = CAR (x);
+        while (t && t != cell_nil)
+          {
+            putchar (VALUE (CAR (t)));
+            t = CDR (t);
+          }
+        break;
+      }
+#endif
     case TSTRING:
+#if __NYACC__
+      // FIXME
+      {}
+#endif
     case TSYMBOL:
       {
         SCM t = CAR (x);
@@ -1093,18 +1121,25 @@ display_ (SCM x)
       }
     default:
       {
-        //fputs ("<default>\n", stdout);
-        fputs ("<", stdout);
-        fputs (itoa (TYPE (x)), stdout);
-        fputs (":", stdout);
-        fputs (itoa (x), stdout);
-        fputs (">", stdout);
+        //gputs ("<default>\n");
+        gputs ("<");
+        gputs (itoa (TYPE (x)));
+        gputs (":");
+        gputs (itoa (x));
+        gputs (">");
         break;
       }
     }
   return 0;
 }
 
+SCM
+display_ (SCM x)
+{
+  g_depth = 5;
+  return display_helper (x, 0, "");
+}
+
 SCM
 stderr_ (SCM x)
 {

diff --git a/scaffold/mini-mes.c b/scaffold/mini-mes.c
index 91f3689551817fd91d0d83922f467e941a70cac4..38ab416eb9663ae28b029c064dbaa30b794b9b1a 100644 (file)
--- a/scaffold/mini-mes.c
+++ b/scaffold/mini-mes.c
@@ -66,7 +66,6 @@ struct scm {
   SCM cdr;
 };
 
-typedef int (*f_t) (void);
 struct function {
   int (*function) (void);
   int arity;
@@ -1131,9 +1130,17 @@ write_byte (SCM x) ///((arity . n))
   return c;
 }
 
+int g_depth;
+
 SCM
-display_ (SCM x)
+display_helper (SCM x, int cont, char* sep)
 {
+  puts (sep);
+  if (g_depth == 0) return cell_unspecified;
+  //FIXME:
+  //g_depth--;
+  g_depth = g_depth - 1;
+  
   // eputs ("<display>\n");
   switch (TYPE (x))
     {
@@ -1154,13 +1161,15 @@ display_ (SCM x)
         puts (p);
         puts ("[");
         puts (itoa (CDR (x)));
+        puts (",");
+        puts (itoa (x));
         puts ("]>");
         break;
       }
     case TMACRO:
       {
         puts ("#<macro ");
-        display_ (cdr (x));
+        display_helper (cdr (x), cont, "");
         puts (">");
         break;
       }
@@ -1172,24 +1181,32 @@ display_ (SCM x)
       }
     case TPAIR:
       {
-        //puts ("<pair>\n");
-        //if (cont != cell_f) puts "(");
-        puts ("(");
+        if (!cont) puts ("(");
         if (x && x != cell_nil) display_ (CAR (x));
-        if (CDR (x) && CDR (x) != cell_nil)
+        if (CDR (x) && TYPE (CDR (x)) == TPAIR)
+          display_helper (CDR (x), 1, " ");
+        else if (CDR (x) && CDR (x) != cell_nil)
           {
             if (TYPE (CDR (x)) != TPAIR)
               puts (" . ");
             display_ (CDR (x));
           }
-        //if (cont != cell_f) puts (")");
-        puts (")");
+        if (!cont) puts (")");
         break;
       }
     case TSPECIAL:
 #if __NYACC__
       // FIXME
-      {}
+      //{}
+      {
+        SCM t = CAR (x);
+        while (t && t != cell_nil)
+          {
+            putchar (VALUE (CAR (t)));
+            t = CDR (t);
+          }
+        break;
+      }
 #endif
     case TSTRING:
 #if __NYACC__
@@ -1220,6 +1237,13 @@ display_ (SCM x)
   return 0;
 }
 
+SCM
+display_ (SCM x)
+{
+  g_depth = 5;
+  return display_helper (x, 0, "");
+}
+
 
 //\f Jam Collector
 SCM g_symbol_max;