lassik
/
upscheme
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

making copy-list a builtin, since the functionality was there anyway. 

adding builtin primitive apply-nlist*, to speed up list* and nlist*
This commit is contained in:
JeffBezanson 2009-05-30 17:54:27 +00:00
parent a23bee041f
commit bbcc68cfdf
4 changed files with 32 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
femtolisp/flisp.boot
View File

@ -83,7 +83,7 @@ nreverse
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-head
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 @@ count
#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

30
femtolisp/flisp.c
View File

@ -702,7 +702,8 @@ static value_t list(value_t *args, uint32_t nargs)
// 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 @@ static value_t apply_liststar(value_t L)
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 @@ static value_t apply_liststar(value_t L)
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 @@ static value_t apply_cl(uint32_t nargs)
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 @@ static builtinspec_t core_builtin_info[] = {
{ "function:env", fl_function_env },
{ "gensym", fl_gensym },
{ "hash", fl_hash },
{ "copy-list", fl_copylist },
{ "apply-nlist*", fl_apply_nliststar },
{ NULL, NULL }
};

14
femtolisp/system.lsp
View File

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