shithub: femtolisp

Info  •  Files  •  Log  •  Branches

making copy-list a builtin, since the functionality was there anyway.
adding builtin primitive apply-nlist*, to speed up list* and nlist*

--- a/femtolisp/compiler.lsp

+++ b/femtolisp/compiler.lsp

@@ -467,7 +467,7 @@

 		  (set! i (+ i 1)))

 		 ((:loada :seta :call :tcall :list :+ :- :* :/ :vector

-			  :argc :vargc :loadi8 :apply :tapply)

+		   :argc :vargc :loadi8 :apply :tapply)

 		  (princ (number->string (aref code i)))

 		  (set! i (+ i 1)))

--- a/femtolisp/flisp.boot

+++ b/femtolisp/flisp.boot

@@ -83,7 +83,7 @@

 nreconc

 #function("n2e0e1f031f142;" [nconc nreverse])

 nlist*

-#function("o0f0N?6=0f0M;f0e0f0NQ2P;" [nlist*])

+#function("o0e0f041;" [apply-nlist*])

 newline

 #function("n0e0e1312];" [princ *linefeed*])

 nestlist

@@ -143,7 +143,7 @@

 list->vector

 #function("n1e0f0t2;" [vector])

 list*

-#function("o0f0N?6=0f0M;f0Me0f0NQ2K;" [list*])

+#function("o0e0e1f03141;" [apply-nlist* copy-list])

 length>

 #function("n2f1`X6<0f0;f1`W6N0f0F16M02f0;f0A6Y0f1`X;e0f0Nf1av42;" [length>])

 length=

@@ -204,8 +204,6 @@

 #function("n2c0^q42;" [#function("rc0mj02f0g00g01`43;" [#function("n3f1A6;0f2;g00f0f1Nf0f1M316T0f2au5V0f243;" [])])])

 copy-tree

 #function("n1f0?6;0f0;e0f0M31e0f0N31K;" [copy-tree])

-copy-list

-#function("n1f0?6;0f0;f0Me0f0N31K;" [copy-list])

 const-to-idx-vec

 #function("n1c0e1f0b2[31q42;" [#function("re0c1mg00a[322f0;" [table.foreach #function("n2g00f1f0\\;" [])]) vector.alloc])

 compile-while

--- a/femtolisp/flisp.c

+++ b/femtolisp/flisp.c

@@ -702,7 +702,8 @@

 // perform (apply list* L)

 // like the function list() above, but takes arguments from a list

 // rather than from an array (the stack)

-static value_t apply_liststar(value_t L)

+// if !star, then it performs copy-list

+static value_t apply_liststar(value_t L, int star)

 {

     PUSH(NIL);

     PUSH(NIL);

@@ -712,7 +713,7 @@

     value_t *pL = &Stack[SP-1];

     value_t c;

     while (iscons(*pL)) {

-        if (iscons(cdr_(*pL))) {

+        if (!star || iscons(cdr_(*pL))) {

             c = mk_cons();

             car_(c) = car_(*pL);

             cdr_(c) = NIL;

@@ -732,6 +733,27 @@

     return POP();

 }

+value_t fl_copylist(value_t *args, u_int32_t nargs)

+{

+    argcount("copy-list", nargs, 1);

+    return apply_liststar(args[0], 0);

+}

+

+value_t fl_apply_nliststar(value_t *args, u_int32_t nargs)

+{

+    argcount("apply-nlist*", nargs, 1);

+    value_t v = args[0];

+    value_t *plastcdr = &args[0];

+    while (iscons(v)) {

+        if (!iscons(cdr_(v)))

+            *plastcdr = car_(v);

+        else

+            plastcdr = &cdr_(v);

+        v = cdr_(v);

+    }

+    return args[0];

+}

+

 static value_t do_trycatch()

 {

     uint32_t saveSP = SP;

@@ -1020,7 +1042,7 @@

         apply_apply:

             v = POP();     // arglist

             if (n > MAX_ARGS) {

-                v = apply_liststar(v);

+                v = apply_liststar(v, 1);

             }

             n = SP-(n-2);  // n-2 == # leading arguments not in the list

             while (iscons(v)) {

@@ -1478,6 +1500,8 @@

     { "function:env", fl_function_env },

     { "gensym", fl_gensym },

     { "hash", fl_hash },

+    { "copy-list", fl_copylist },

+    { "apply-nlist*", fl_apply_nliststar },

     { NULL, NULL }

 };

--- a/femtolisp/system.lsp

+++ b/femtolisp/system.lsp

@@ -182,15 +182,9 @@

 	((null? lst) (= n 0))

 	(else        (length= (cdr lst) (- n 1)))))

-(define (list* . l)

-  (if (atom? (cdr l))

-      (car l)

-      (cons (car l) (apply list* (cdr l)))))

+(define (list* . l) (apply-nlist* (copy-list l)))

-(define (nlist* . l)

-  (if (atom? (cdr l))

-      (car l)

-      (set-cdr! l (apply nlist* (cdr l)))))

+(define (nlist* . l) (apply-nlist* l))

 (define (lastcdr l)

   (if (atom? l) l

@@ -255,10 +249,6 @@

 (define (reverse lst) (foldl cons () lst))

-(define (copy-list l)

-  (if (atom? l) l

-    (cons (car l)

-          (copy-list (cdr l)))))

 (define (copy-tree l)

   (if (atom? l) l

     (cons (copy-tree (car l))