simplifying copy-list

improving the gambit-like read-line function
adding with-output-to-string

femtolisp/aliases.scm

@@ -276,7 +276,15 @@
 (define make-table table)
 (define table-ref get)
 (define table-set! put!)
-(define (read-line (s *input-stream*)) (io.readline s))
+(define (read-line (s *input-stream*))
+  (io.flush *output-stream*)
+  (io.discardbuffer s)
+  (io.readline s))
 (define (shell-command s) 1)
-(define (error-exception-message e) e)
+(define (error-exception-message e) (cadr e))
-(define (error-exception-parameters e) e)
+(define (error-exception-parameters e) (cddr e))
+
+(define (with-output-to-string nada thunk)
+  (let ((b (buffer)))
+    (with-output-to b (thunk))
+    (io.tostring! b)))

femtolisp/flisp.c

@@ -754,40 +754,31 @@ static value_t _list(value_t *args, uint32_t nargs, int star)
     return v;
 }
 
-#define FL_COPYLIST(l) apply_liststar((l),0)
+static value_t copy_list(value_t L)
-
-// perform (apply list* L)
-// like the function list() above, but takes arguments from a list
-// rather than from an array (the stack)
-// if !star, then it performs copy-list
-static value_t apply_liststar(value_t L, int star)
 {
-    PUSH(NIL);
+    if (!iscons(L))
+        return NIL;
     PUSH(NIL);
     PUSH(L);
-    value_t *pfirst = &Stack[SP-3];
     value_t *plcons = &Stack[SP-2];
     value_t *pL = &Stack[SP-1];
     value_t c;
+    c = mk_cons(); PUSH(c);  // save first cons
+    car_(c) = car_(*pL);
+    cdr_(c) = NIL;
+    *plcons = c;
+    *pL = cdr_(*pL);
     while (iscons(*pL)) {
-        if (!star || iscons(cdr_(*pL))) {
+        c = mk_cons();
-            c = mk_cons();
+        car_(c) = car_(*pL);
-            car_(c) = car_(*pL);
+        cdr_(c) = NIL;
-            cdr_(c) = NIL;
+        cdr_(*plcons) = c;
-        }
-        else {
-            // last element; becomes final CDR
-            c = car_(*pL);
-        }
-        if (*pfirst == NIL)
-            *pfirst = c;
-        else
-            cdr_(*plcons) = c;
         *plcons = c;
         *pL = cdr_(*pL);
     }
+    c = POP();  // first cons
     POPN(2);
-    return POP();
+    return c;
 }
 
 static value_t do_trycatch()
@@ -2082,7 +2073,7 @@ static value_t fl_function_name(value_t *args, uint32_t nargs)
 value_t fl_copylist(value_t *args, u_int32_t nargs)
 {
     argcount("copy-list", nargs, 1);
-    return FL_COPYLIST(args[0]);
+    return copy_list(args[0]);
 }
 
 value_t fl_append(value_t *args, u_int32_t nargs)
@@ -2097,7 +2088,7 @@ value_t fl_append(value_t *args, u_int32_t nargs)
         lst = args[i++];
         if (i >= nargs) break;
         if (iscons(lst)) {
-            lst = FL_COPYLIST(lst);
+            lst = copy_list(lst);
             if (first == NIL)
                 first = lst;
             else