diff --git a/mes.c b/mes.c index 880a02ba..fa794b87 100644 --- 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 ("\n"); switch (TYPE (x)) { case TCHAR: { - //fputs ("\n", stdout); - fputs ("#\\", stdout); + //puts ("\n"); + gputs ("#\\"); putchar (VALUE (x)); break; } case TFUNCTION: { - fputs ("#", stdout); + gputs (p); + gputs ("["); + gputs (itoa (CDR (x))); + gputs (","); + gputs (itoa (x)); + gputs ("]>"); break; } case TMACRO: { - fputs ("#", 1); + gputs ("#"); break; } case TNUMBER: { - //fputs ("\n", stdout); - fputs (itoa (VALUE (x)), stdout); + //gputs ("\n"); + gputs (itoa (VALUE (x))); break; } case TPAIR: { - //fputs ("\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 ("\n", stdout); - fputs ("<", stdout); - fputs (itoa (TYPE (x)), stdout); - fputs (":", stdout); - fputs (itoa (x), stdout); - fputs (">", stdout); + //gputs ("\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 91f36895..38ab416e 100644 --- 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 ("\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 ("#"); break; } @@ -1172,24 +1181,32 @@ display_ (SCM x) } case TPAIR: { - //puts ("\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, ""); +} + // Jam Collector SCM g_symbol_max;