shithub: femtolisp

Info  •  Files  •  Log  •  Branches

some printing improvements

- don't print shared references to cprims, and estimate their
  size better. previously you could get output like this:

```
(#0=#\a
 #0#)
```

Now it looks like:

```
(#\a #\a)
```

- print `#\ ` and `#\newline` instead of `#\space` and `#\linefeed`.
  these seem to be more standard.

--- a/print.c

+++ b/print.c

@@ -89,9 +89,6 @@

         for(i=0; i < vector_size(v); i++)

             print_traverse(vector_elt(v,i));

     }

-    else if (iscprim(v)) {

-        mark_cons(v);

-    }

     else if (isclosure(v)) {

         mark_cons(v);

         function_t *f = (function_t*)ptr(v);

@@ -171,7 +168,7 @@

     if (fl_isstring(v))

         return (cv_len((cvalue_t*)ptr(v)) < SMALL_STR_LEN);

     return (isfixnum(v) || isbuiltin(v) || v==FL_F || v==FL_T || v==FL_NIL ||

-            v == FL_EOF);

+            v == FL_EOF || iscprim(v));

 }

 static int smallp(value_t v)

@@ -208,6 +205,8 @@

     // get the width of an expression if we can do so cheaply

     if (issymbol(v))

         return u8_strwidth(symbol_name(v));

+    if (iscprim(v) && cp_class((cprim_t*)ptr(v)) == wchartype)

+        return 4;

     return -1;

 }

@@ -441,9 +440,13 @@

             }

         }

         break;

-    case TAG_CVALUE:

     case TAG_CPRIM:

-        if (v == UNBOUND) { outs("#<undefined>", f); break; }

+        if (v == UNBOUND)

+            outs("#<undefined>", f);

+        else

+            cvalue_print(f, v);

+        break;

+    case TAG_CVALUE:

     case TAG_VECTOR:

     case TAG_CONS:

         if (print_circle_prefix(f, v)) break;

@@ -477,7 +480,7 @@

             outc(']', f);

             break;

         }

-        if (iscvalue(v) || iscprim(v))

+        if (iscvalue(v))

             cvalue_print(f, v);

         else

             print_pair(f, v);

@@ -640,13 +643,13 @@

             else if (wc == 0x07) outsn("alarm", f, 5);

             else if (wc == 0x08) outsn("backspace", f, 9);

             else if (wc == 0x09) outsn("tab", f, 3);

-            else if (wc == 0x0A) outsn("linefeed", f, 8);

-            //else if (wc == 0x0A) outsn("newline", f, 7);

+            //else if (wc == 0x0A) outsn("linefeed", f, 8);

+            else if (wc == 0x0A) outsn("newline", f, 7);

             else if (wc == 0x0B) outsn("vtab", f, 4);

             else if (wc == 0x0C) outsn("page", f, 4);

             else if (wc == 0x0D) outsn("return", f, 6);

             else if (wc == 0x1B) outsn("esc", f, 3);

-            else if (wc == 0x20) outsn("space", f, 5);

+            //else if (wc == 0x20) outsn("space", f, 5);

             else if (wc == 0x7F) outsn("delete", f, 6);

             else if (iswprint(wc)) outs(seq, f);

             else HPOS+=ios_printf(f, "x%04x", (int)wc);

--- a/string.c

+++ b/string.c

@@ -230,7 +230,7 @@

     argcount("char.upcase", nargs, 1);

     cprim_t *cp = (cprim_t*)ptr(args[0]);

     if (!iscprim(args[0]) || cp_class(cp) != wchartype)

-      type_error("char.upcase", "wchar", args[0]);

+        type_error("char.upcase", "wchar", args[0]);

     return mk_wchar(towupper(*(int32_t*)cp_data(cp)));

 }

 value_t fl_char_downcase(value_t *args, u_int32_t nargs)

@@ -238,7 +238,7 @@

     argcount("char.downcase", nargs, 1);

     cprim_t *cp = (cprim_t*)ptr(args[0]);

     if (!iscprim(args[0]) || cp_class(cp) != wchartype)

-      type_error("char.downcase", "wchar", args[0]);

+        type_error("char.downcase", "wchar", args[0]);

     return mk_wchar(towlower(*(int32_t*)cp_data(cp)));

 }