shithub: femtolisp

Download patch

ref: 05ef9f42a52c48e951e8dc21b5b37126008658f2
parent: e2b7652e36a03d6a07b73af884e53d8e87c7fde1
author: JeffBezanson <jeff.bezanson@gmail.com>
date: Wed Mar 11 10:52:37 EDT 2009

simplifying (string) to just princ-to-string
small printing improvements


--- a/femtolisp/flisp.c
+++ b/femtolisp/flisp.c
@@ -274,25 +274,14 @@
     return gensym(NULL, 0);
 }
 
-static char *snprintf_gensym_id(char *nbuf, size_t n, uint32_t g)
-{
-    size_t i=n-1;
-
-    nbuf[i--] = '\0';
-    do {
-        nbuf[i--] = '0' + g%10;
-        g/=10;
-    } while (g && i);
-    nbuf[i] = 'g';
-    return &nbuf[i];
-}
-
 char *symbol_name(value_t v)
 {
     if (ismanaged(v)) {
         gensym_t *gs = (gensym_t*)ptr(v);
         gsnameno = 1-gsnameno;
-        return snprintf_gensym_id(gsname[gsnameno], sizeof(gsname[0]), gs->id);
+        char *n = int2str(gsname[gsnameno]+1, sizeof(gsname[0])-1, gs->id, 10);
+        *(--n) = 'g';
+        return n;
     }
     return ((symbol_t*)ptr(v))->name;
 }
@@ -1593,7 +1582,7 @@
         (void)toplevel_eval(special_apply_form);
     }
     FL_CATCH {
-        ios_printf(ios_stderr, "fatal error during bootstrap:\n");
+        ios_puts("fatal error during bootstrap:\n", ios_stderr);
         print(ios_stderr, lasterror, 0);
         ios_putc('\n', ios_stderr);
         return 1;
--- a/femtolisp/print.c
+++ b/femtolisp/print.c
@@ -379,7 +379,7 @@
         break;
     case TAG_CVALUE:
     case TAG_CPRIM:
-      if (v == UNBOUND) { HPOS+=ios_printf(f, "#<undefined>"); break; }
+      if (v == UNBOUND) { outs("#<undefined>", f); break; }
     case TAG_VECTOR:
     case TAG_CONS:
         if ((label=(value_t)ptrhash_get(&printconses, (void*)v)) !=
@@ -523,16 +523,18 @@
                 rep = sign_bit(d) ? "-NaN" : "+NaN";
             else
                 rep = sign_bit(d) ? "-Inf" : "+Inf";
-            if (type == floatsym)
+            if (type == floatsym && !princ && !weak)
                 HPOS+=ios_printf(f, "#%s(%s)", symbol_name(type), rep);
             else
-                HPOS+=ios_printf(f, "%s", rep);
+                outs(rep, f);
         }
         else if (d == 0) {
             if (1/d < 0)
-                HPOS+=ios_printf(f, "-0.0%s", type==floatsym?"f":"");
+                outs("-0.0", f);
             else
-                HPOS+=ios_printf(f, "0.0%s",  type==floatsym?"f":"");
+                outs("0.0", f);
+            if (type == floatsym && !princ && !weak)
+                outc('f', f);
         }
         else {
             snprint_real(buf, sizeof(buf), d, 0, ndec, 3, 10);
@@ -539,9 +541,8 @@
             int hasdec = (strpbrk(buf, ".eE") != NULL);
             outs(buf, f);
             if (!hasdec) outs(".0", f);
-            if (!princ && !weak) {
-                if (type == floatsym) outc('f', f);
-            }
+            if (type == floatsym && !princ && !weak)
+                outc('f', f);
         }
     }
     else if (issymbol(type)) {
--- a/femtolisp/string.c
+++ b/femtolisp/string.c
@@ -14,20 +14,6 @@
 #include "llt.h"
 #include "flisp.h"
 
-extern value_t fl_buffer(value_t *args, u_int32_t nargs);
-extern value_t stream_to_string(value_t *ps);
-static value_t print_to_string(value_t v, int princ)
-{
-    PUSH(v);
-    value_t buf = fl_buffer(NULL, 0);
-    ios_t *s = value2c(ios_t*,buf);
-    print(s, Stack[SP-1], princ);
-    Stack[SP-1] = buf;
-    value_t outp = stream_to_string(&Stack[SP-1]);
-    (void)POP();
-    return outp;
-}
-
 value_t fl_stringp(value_t *args, u_int32_t nargs)
 {
     argcount("string?", nargs, 1);
@@ -113,74 +99,22 @@
     return wcstr;
 }
 
+extern value_t fl_buffer(value_t *args, u_int32_t nargs);
+extern value_t stream_to_string(value_t *ps);
+
 value_t fl_string(value_t *args, u_int32_t nargs)
 {
-    value_t cv, t;
-    u_int32_t i;
-    size_t len, sz = 0;
-    cvalue_t *temp;
-    cprim_t *cp;
-    char *data;
-    uint32_t wc;
-
-    for(i=0; i < nargs; i++) {
-        cv = args[i];
-        if (issymbol(cv)) {
-            sz += strlen(symbol_name(cv));
-            continue;
-        }
-        else if (iscprim(cv)) {
-            cp = (cprim_t*)ptr(cv);
-            t = cp_type(cp);
-            if (t == bytesym) {
-                sz++;
-                continue;
-            }
-            else if (t == wcharsym) {
-                wc = *(uint32_t*)cp_data(cp);
-                sz += u8_charlen(wc);
-                continue;
-            }
-        }
-        else if (isstring(cv)) {
-            sz += cv_len((cvalue_t*)ptr(cv));
-            continue;
-        }
-        args[i] = print_to_string(args[i], iscprim(args[i])||isbuiltinish(args[i]));
-        if (nargs == 1)  // convert single value to string
-            return args[i];
-        sz += cv_len((cvalue_t*)ptr(args[i]));
-        //lerror(ArgError, "string: expected string, symbol or character");
-    }
-    cv = cvalue_string(sz);
-    char *ptr = cvalue_data(cv);
-    for(i=0; i < nargs; i++) {
-        if (issymbol(args[i])) {
-            char *name = symbol_name(args[i]);
-            while (*name) *ptr++ = *name++;
-        }
-        else if (iscprim(args[i])) {
-            cp = (cprim_t*)ptr(args[i]);
-            t = cp_type(cp);
-            data = cp_data(cp);
-            if (t == bytesym) {
-                *ptr++ = *(char*)data;
-            }
-            else {
-                // wchar
-                ptr += u8_wc_toutf8(ptr, *(uint32_t*)data);
-            }
-        }
-        else {
-            // string
-            temp = (cvalue_t*)ptr(args[i]);
-            data = cv_data(temp);
-            len = cv_len(temp);
-            memcpy(ptr, data, len);
-            ptr += len;
-        }
-    }
-    return cv;
+    if (nargs == 1 && isstring(args[0]))
+        return args[0];
+    value_t buf = fl_buffer(NULL, 0);
+    ios_t *s = value2c(ios_t*,buf);
+    uint32_t i;
+    for (i=0; i < nargs; i++)
+        print(s, args[i], 1);
+    PUSH(buf);
+    value_t outp = stream_to_string(&Stack[SP-1]);
+    (void)POP();
+    return outp;
 }
 
 value_t fl_string_split(value_t *args, u_int32_t nargs)