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

fix a bug in map 

faster delete-duplicates for long lists
This commit is contained in:
Jeff Bezanson 2013-02-11 04:48:21 -05:00
parent 71a1cb6f09
commit ee807a2cf3
3 changed files with 36 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
flisp.boot
View File

@ -79,7 +79,7 @@
__start #fn("8000r1e0302|NF6D0|Nk12^k22e3|\x84315E0|k12]k22e4e5312e6302e7`41;" [__init_globals __start #fn("8000r1e0302|NF6D0|Nk12^k22e3|\x84315E0|k12]k22e4e5312e6302e7`41;" [__init_globals
*argv* *interactive* __script princ *banner* repl exit] __start) *argv* *interactive* __script princ *banner* repl exit] __start)
abs #fn("7000r1|`X650|y;|;" [] abs) any abs #fn("7000r1|`X650|y;|;" [] abs) any
#fn("8000r2}F16D02|}M3117:02e0|}N42;" [any] any) arg-counts #table(#.not 1 #.atom? 1 #.number? 1 #.cons 2 #.set-cdr! 2 #.equal? 2 #.fixnum? 1 #.bound? 1 #.eq? 2 #.symbol? 1 #.builtin? 1 #.< 2 #.aset! 3 #.div0 2 #.cdr 1 #.null? 1 #.eqv? 2 #.compare 2 #.aref 2 #.car 1 #.set-car! 2 #.pair? 1 #.= 2 #.vector? 1 #.boolean? 1) #fn("8000r2}F16D02|}M3117:02e0|}N42;" [any] any) arg-counts #table(#.equal? 2 #.atom? 1 #.set-cdr! 2 #.symbol? 1 #.car 1 #.eq? 2 #.aref 2 #.boolean? 1 #.not 1 #.null? 1 #.eqv? 2 #.number? 1 #.pair? 1 #.builtin? 1 #.aset! 3 #.div0 2 #.= 2 #.bound? 1 #.compare 2 #.vector? 1 #.cdr 1 #.set-car! 2 #.< 2 #.fixnum? 1 #.cons 2)
argc-error #fn("<000r2e0c1|c2}}aW670c3540c445;" [error "compile error: " argc-error #fn("<000r2e0c1|c2}}aW670c3540c445;" [error "compile error: "
" expects " " argument." " expects " " argument."
" arguments."] argc-error) " arguments."] argc-error)
@ -104,7 +104,7 @@
#.cons bq-process nconc list*]) lastcdr map #fn("8000r1e0|\x7f42;" [bq-bracket1]) #.cons bq-process nconc list*]) lastcdr map #fn("8000r1e0|\x7f42;" [bq-bracket1])
#fn("6000r1c0qm02|;" [#fn(">000r2|\x85;0c0e1}31K;|F6s0|Mc2\x82[0c0e3}i11`W670|N5E0c4c5L2e6|Ni11ax32L232K;~|Ne7|Mi1132}K42;c0e1e6|i1132}K31K;" [nconc #fn("6000r1c0qm02|;" [#fn(">000r2|\x85;0c0e1}31K;|F6s0|Mc2\x82[0c0e3}i11`W670|N5E0c4c5L2e6|Ni11ax32L232K;~|Ne7|Mi1132}K42;c0e1e6|i1132}K31K;" [nconc
reverse! unquote nreconc #.list 'unquote bq-process bq-bracket])])] bq-process) reverse! unquote nreconc #.list 'unquote bq-process bq-bracket])])] bq-process)
builtin->instruction #fn("9000r1e0~|^43;" [get] [#table(#.number? number? #.cons cons #.fixnum? fixnum? #.equal? equal? #.eq? eq? #.symbol? symbol? #.div0 div0 #.builtin? builtin? #.aset! aset! #.- - #.boolean? boolean? #.not not #.apply apply #.atom? atom? #.set-cdr! set-cdr! #./ / #.function? function? #.vector vector #.list list #.bound? bound? #.< < #.* * #.cdr cdr #.null? null? #.+ + #.eqv? eqv? #.compare compare #.aref aref #.set-car! set-car! #.car car #.pair? pair? #.= = #.vector? vector?) builtin->instruction #fn("9000r1e0~|^43;" [get] [#table(#.equal? equal? #.* * #.car car #.apply apply #.aref aref #.- - #.boolean? boolean? #.builtin? builtin? #.null? null? #.eqv? eqv? #.function? function? #.bound? bound? #.cdr cdr #.list list #.set-car! set-car! #.cons cons #.atom? atom? #.set-cdr! set-cdr! #.symbol? symbol? #.eq? eq? #.vector vector #.not not #.pair? pair? #.number? number? #.div0 div0 #.aset! aset! #.+ + #.= = #.compare compare #.vector? vector? #./ / #.< < #.fixnum? fixnum?)
()]) ()])
caaaar #fn("6000r1|MMMM;" [] caaaar) caaadr caaaar #fn("6000r1|MMMM;" [] caaaar) caaadr
#fn("6000r1|\x84MM;" [] caaadr) caaar #fn("6000r1|MMM;" [] caaar) #fn("6000r1|\x84MM;" [] caaadr) caaar #fn("6000r1|MMM;" [] caaar)
@ -154,7 +154,7 @@
keyargs emit-optional-arg-inits > 255 largc lvargc vargc argc compile-in ret keyargs emit-optional-arg-inits > 255 largc lvargc vargc argc compile-in ret
values function encode-byte-code bcode:code const-to-idx-vec]) filter values function encode-byte-code bcode:code const-to-idx-vec]) filter
keyword-arg?]) length]) length]) make-code-emitter lastcdr lambda-vars filter keyword-arg?]) length]) length]) make-code-emitter lastcdr lambda-vars filter
#.pair? lambda])] #0=[#:g709 ()]) #.pair? lambda])] #0=[#:g711 ()])
compile-for #fn(":000r5e0g4316X0e1|}^g2342e1|}^g3342e1|}^g4342e2|c342;e4c541;" [1arg-lambda? compile-for #fn(":000r5e0g4316X0e1|}^g2342e1|}^g3342e1|}^g4342e2|c342;e4c541;" [1arg-lambda?
compile-in emit for error "for: third form must be a 1-argument lambda"] compile-for) compile-in emit for error "for: third form must be a 1-argument lambda"] compile-for)
compile-if #fn("<000r4c0qe1|31e1|31g3\x84e2g331e3g331F6;0e4g331560e53045;" [#fn(";000r5g2]\x82>0e0~\x7fi02g344;g2^\x82>0e0~\x7fi02g444;e0~\x7f^g2342e1~c2|332e0~\x7fi02g3342i026<0e1~c3325:0e1~c4}332e5~|322e0~\x7fi02g4342e5~}42;" [compile-in compile-if #fn("<000r4c0qe1|31e1|31g3\x84e2g331e3g331F6;0e4g331560e53045;" [#fn(";000r5g2]\x82>0e0~\x7fi02g344;g2^\x82>0e0~\x7fi02g444;e0~\x7f^g2342e1~c2|332e0~\x7fi02g3342i026<0e1~c3325:0e1~c4}332e5~|322e0~\x7fi02g4342e5~}42;" [compile-in
@ -187,8 +187,9 @@
#fn("8000r2~}|\\;" []) bcode:ctable]) vector.alloc bcode:nconst] const-to-idx-vec) #fn("8000r2~}|\\;" []) bcode:ctable]) vector.alloc bcode:nconst] const-to-idx-vec)
copy-tree #fn("8000r1|?640|;e0|M31e0|N31K;" [copy-tree] copy-tree) copy-tree #fn("8000r1|?640|;e0|M31e0|N31K;" [copy-tree] copy-tree)
count #fn("7000r2c0q]41;" [#fn("9000r1c0qm02|~\x7f`43;" [#fn(":000r3}\x8550g2;~|}N|}M31690g2aw540g243;" [] count-)])] count) count #fn("7000r2c0q]41;" [#fn("9000r1c0qm02|~\x7f`43;" [#fn(":000r3}\x8550g2;~|}N|}M31690g2aw540g243;" [] count-)])] count)
delete-duplicates #fn("8000r1|?640|;c0|M|N42;" [#fn("8000r2e0|}32680e1}41;|e1}31K;" [member delete-duplicates #fn("8000r1e0|bD326<0c1qe23041;|?640|;c3|M|N42;" [length>
delete-duplicates])] delete-duplicates) #fn("8000r1e0c1q~322e2|41;" [for-each #fn("9000r1e0~|]43;" [put!]) table.keys])
table #fn("8000r2e0|}32680e1}41;|e1}31K;" [member delete-duplicates])] delete-duplicates)
disassemble #fn("=000s1}\x85C0e0|`322e1302];530]2c2}Me3|31e4|3143;" [disassemble disassemble #fn("=000s1}\x85C0e0|`322e1302];530]2c2}Me3|31e4|3143;" [disassemble
newline #fn("7000r3c0q]41;" [#fn(":000r1c0qm02`~axc1u2e2c3e4\x7f`32c5332c6qb4e7\x7f3142;" [#fn("9000r1|J16602|G@6D0e0c1312e2|i10aw42;e3|41;" [princ newline #fn("7000r3c0q]41;" [#fn(":000r1c0qm02`~axc1u2e2c3e4\x7f`32c5332c6qb4e7\x7f3142;" [#fn("9000r1|J16602|G@6D0e0c1312e2|i10aw42;e3|41;" [princ
"\n" disassemble print] print-val) #fn("7000r1e0c141;" [princ "\t"]) princ "maxstack " "\n" disassemble print] print-val) #fn("7000r1e0c141;" [princ "\t"]) princ "maxstack "

34
flisp.c
View File

@ -604,7 +604,7 @@ void gc(int mustgrow)
gc(0); gc(0);
} }
static void grow_stack() static void grow_stack(void)
{ {
size_t newsz = N_STACK + (N_STACK>>1); size_t newsz = N_STACK + (N_STACK>>1);
value_t *ns = realloc(Stack, newsz*sizeof(value_t)); value_t *ns = realloc(Stack, newsz*sizeof(value_t));
@ -796,7 +796,7 @@ static value_t copy_list(value_t L)
return c; return c;
} }
static value_t do_trycatch() static value_t do_trycatch(void)
{ {
uint32_t saveSP = SP; uint32_t saveSP = SP;
value_t v; value_t v;
@ -2148,28 +2148,30 @@ value_t fl_map1(value_t *args, u_int32_t nargs)
lerror(ArgError, "map: too few arguments"); lerror(ArgError, "map: too few arguments");
if (!iscons(args[1])) return NIL; if (!iscons(args[1])) return NIL;
value_t first, last, v; value_t first, last, v;
int64_t argSP = args-Stack;
assert(argSP >= 0 && argSP < N_STACK);
if (nargs == 2) { if (nargs == 2) {
if (SP+3 > N_STACK) grow_stack(); if (SP+3 > N_STACK) grow_stack();
PUSH(args[0]); PUSH(Stack[argSP]);
PUSH(car_(args[1])); PUSH(car_(Stack[argSP+1]));
v = _applyn(1); v = _applyn(1);
PUSH(v); PUSH(v);
v = mk_cons(); v = mk_cons();
car_(v) = POP(); cdr_(v) = NIL; car_(v) = POP(); cdr_(v) = NIL;
last = first = v; last = first = v;
args[1] = cdr_(args[1]); Stack[argSP+1] = cdr_(Stack[argSP+1]);
fl_gc_handle(&first); fl_gc_handle(&first);
fl_gc_handle(&last); fl_gc_handle(&last);
while (iscons(args[1])) { while (iscons(Stack[argSP+1])) {
Stack[SP-2] = args[0]; Stack[SP-2] = Stack[argSP];
Stack[SP-1] = car_(args[1]); Stack[SP-1] = car_(Stack[argSP+1]);
v = _applyn(1); v = _applyn(1);
PUSH(v); PUSH(v);
v = mk_cons(); v = mk_cons();
car_(v) = POP(); cdr_(v) = NIL; car_(v) = POP(); cdr_(v) = NIL;
cdr_(last) = v; cdr_(last) = v;
last = v; last = v;
args[1] = cdr_(args[1]); Stack[argSP+1] = cdr_(Stack[argSP+1]);
} }
POPN(2); POPN(2);
fl_free_gc_handles(2); fl_free_gc_handles(2);
@ -2177,10 +2179,10 @@ value_t fl_map1(value_t *args, u_int32_t nargs)
else { else {
size_t i; size_t i;
while (SP+nargs+1 > N_STACK) grow_stack(); while (SP+nargs+1 > N_STACK) grow_stack();
PUSH(args[0]); PUSH(Stack[argSP]);
for(i=1; i < nargs; i++) { for(i=1; i < nargs; i++) {
PUSH(car(args[i])); PUSH(car(Stack[argSP+i]));
args[i] = cdr_(args[i]); Stack[argSP+i] = cdr_(Stack[argSP+i]);
} }
v = _applyn(nargs-1); v = _applyn(nargs-1);
PUSH(v); PUSH(v);
@ -2189,11 +2191,11 @@ value_t fl_map1(value_t *args, u_int32_t nargs)
last = first = v; last = first = v;
fl_gc_handle(&first); fl_gc_handle(&first);
fl_gc_handle(&last); fl_gc_handle(&last);
while (iscons(args[1])) { while (iscons(Stack[argSP+1])) {
Stack[SP-nargs] = args[0]; Stack[SP-nargs] = Stack[argSP];
for(i=1; i < nargs; i++) { for(i=1; i < nargs; i++) {
Stack[SP-nargs+i] = car(args[i]); Stack[SP-nargs+i] = car(Stack[argSP+i]);
args[i] = cdr_(args[i]); Stack[argSP+i] = cdr_(Stack[argSP+i]);
} }
v = _applyn(nargs-1); v = _applyn(nargs-1);
PUSH(v); PUSH(v);

20
system.lsp
View File

@ -340,14 +340,18 @@
(copy-tree (cdr l))))) (copy-tree (cdr l)))))
(define (delete-duplicates lst) (define (delete-duplicates lst)
(if (atom? lst) (if (length> lst 20)
lst (let ((t (table)))
(let ((elt (car lst)) (for-each (lambda (elt) (put! t elt #t)) lst)
(tail (cdr lst))) (table.keys t))
(if (member elt tail) (if (atom? lst)
(delete-duplicates tail) lst
(cons elt (let ((elt (car lst))
(delete-duplicates tail)))))) (tail (cdr lst)))
(if (member elt tail)
(delete-duplicates tail)
(cons elt
(delete-duplicates tail)))))))
; backquote ------------------------------------------------------------------- ; backquote -------------------------------------------------------------------