From ee807a2cf3eaa7df64f6544dc72a8bf3fe9e54f3 Mon Sep 17 00:00:00 2001 From: Jeff Bezanson Date: Mon, 11 Feb 2013 04:48:21 -0500 Subject: [PATCH] fix a bug in map faster delete-duplicates for long lists --- flisp.boot | 11 ++++++----- flisp.c | 34 ++++++++++++++++++---------------- system.lsp | 20 ++++++++++++-------- 3 files changed, 36 insertions(+), 29 deletions(-) diff --git a/flisp.boot b/flisp.boot index 7e18ee0..70286fa 100644 --- a/flisp.boot +++ b/flisp.boot @@ -79,7 +79,7 @@ __start #fn("8000r1e0302|NF6D0|Nk12^k22e3|\x84315E0|k12]k22e4e5312e6302e7`41;" [__init_globals *argv* *interactive* __script princ *banner* repl exit] __start) 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: " " expects " " argument." " arguments."] argc-error) @@ -104,7 +104,7 @@ #.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 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 #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 values function encode-byte-code bcode:code const-to-idx-vec]) 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-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 @@ -187,8 +187,9 @@ #fn("8000r2~}|\\;" []) bcode:ctable]) vector.alloc bcode:nconst] const-to-idx-vec) 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) - delete-duplicates #fn("8000r1|?640|;c0|M|N42;" [#fn("8000r2e0|}32680e1}41;|e1}31K;" [member - delete-duplicates])] delete-duplicates) + delete-duplicates #fn("8000r1e0|bD326<0c1qe23041;|?640|;c3|M|N42;" [length> + #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 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 " diff --git a/flisp.c b/flisp.c index db39958..ca2a2b7 100644 --- a/flisp.c +++ b/flisp.c @@ -604,7 +604,7 @@ void gc(int mustgrow) gc(0); } -static void grow_stack() +static void grow_stack(void) { size_t newsz = N_STACK + (N_STACK>>1); value_t *ns = realloc(Stack, newsz*sizeof(value_t)); @@ -796,7 +796,7 @@ static value_t copy_list(value_t L) return c; } -static value_t do_trycatch() +static value_t do_trycatch(void) { uint32_t saveSP = SP; value_t v; @@ -2148,28 +2148,30 @@ value_t fl_map1(value_t *args, u_int32_t nargs) lerror(ArgError, "map: too few arguments"); if (!iscons(args[1])) return NIL; value_t first, last, v; + int64_t argSP = args-Stack; + assert(argSP >= 0 && argSP < N_STACK); if (nargs == 2) { if (SP+3 > N_STACK) grow_stack(); - PUSH(args[0]); - PUSH(car_(args[1])); + PUSH(Stack[argSP]); + PUSH(car_(Stack[argSP+1])); v = _applyn(1); PUSH(v); v = mk_cons(); car_(v) = POP(); cdr_(v) = NIL; last = first = v; - args[1] = cdr_(args[1]); + Stack[argSP+1] = cdr_(Stack[argSP+1]); fl_gc_handle(&first); fl_gc_handle(&last); - while (iscons(args[1])) { - Stack[SP-2] = args[0]; - Stack[SP-1] = car_(args[1]); + while (iscons(Stack[argSP+1])) { + Stack[SP-2] = Stack[argSP]; + Stack[SP-1] = car_(Stack[argSP+1]); v = _applyn(1); PUSH(v); v = mk_cons(); car_(v) = POP(); cdr_(v) = NIL; cdr_(last) = v; last = v; - args[1] = cdr_(args[1]); + Stack[argSP+1] = cdr_(Stack[argSP+1]); } POPN(2); fl_free_gc_handles(2); @@ -2177,10 +2179,10 @@ value_t fl_map1(value_t *args, u_int32_t nargs) else { size_t i; while (SP+nargs+1 > N_STACK) grow_stack(); - PUSH(args[0]); + PUSH(Stack[argSP]); for(i=1; i < nargs; i++) { - PUSH(car(args[i])); - args[i] = cdr_(args[i]); + PUSH(car(Stack[argSP+i])); + Stack[argSP+i] = cdr_(Stack[argSP+i]); } v = _applyn(nargs-1); PUSH(v); @@ -2189,11 +2191,11 @@ value_t fl_map1(value_t *args, u_int32_t nargs) last = first = v; fl_gc_handle(&first); fl_gc_handle(&last); - while (iscons(args[1])) { - Stack[SP-nargs] = args[0]; + while (iscons(Stack[argSP+1])) { + Stack[SP-nargs] = Stack[argSP]; for(i=1; i < nargs; i++) { - Stack[SP-nargs+i] = car(args[i]); - args[i] = cdr_(args[i]); + Stack[SP-nargs+i] = car(Stack[argSP+i]); + Stack[argSP+i] = cdr_(Stack[argSP+i]); } v = _applyn(nargs-1); PUSH(v); diff --git a/system.lsp b/system.lsp index 816353c..1d6cdf8 100644 --- a/system.lsp +++ b/system.lsp @@ -340,14 +340,18 @@ (copy-tree (cdr l))))) (define (delete-duplicates lst) - (if (atom? lst) - lst - (let ((elt (car lst)) - (tail (cdr lst))) - (if (member elt tail) - (delete-duplicates tail) - (cons elt - (delete-duplicates tail)))))) + (if (length> lst 20) + (let ((t (table))) + (for-each (lambda (elt) (put! t elt #t)) lst) + (table.keys t)) + (if (atom? lst) + lst + (let ((elt (car lst)) + (tail (cdr lst))) + (if (member elt tail) + (delete-duplicates tail) + (cons elt + (delete-duplicates tail))))))) ; backquote -------------------------------------------------------------------