shithub: femtolisp

Info  •  Files  •  Log

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

--- a/femtolisp/aliases.scm

+++ b/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-parameters e) e)

+(define (error-exception-message e) (cadr 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)))

--- a/femtolisp/flisp.c

+++ b/femtolisp/flisp.c

@@ -754,40 +754,31 @@

     return v;

 }

-#define FL_COPYLIST(l) apply_liststar((l),0)

-

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

+static value_t copy_list(value_t L)

 {

+    if (!iscons(L))

+        return NIL;

     PUSH(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();

-            car_(c) = car_(*pL);

-            cdr_(c) = NIL;

-        }

-        else {

-            // last element; becomes final CDR

-            c = car_(*pL);

-        }

-        if (*pfirst == NIL)

-            *pfirst = c;

-        else

-            cdr_(*plcons) = c;

+        c = mk_cons();

+        car_(c) = car_(*pL);

+        cdr_(c) = NIL;

+        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 @@

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

         lst = args[i++];

         if (i >= nargs) break;

         if (iscons(lst)) {

-            lst = FL_COPYLIST(lst);

+            lst = copy_list(lst);

             if (first == NIL)

                 first = lst;

             else