shithub: sl

--- 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)

--

⑨