From: Jason Kantz
Subject: Why is this consing?!
Date: 
Message-ID: <1136576992.938496.52750@g47g2000cwa.googlegroups.com>
Anyone care to give me some pointers on how to figure out why this
function, consistentp, is consing ...

(defstruct (node (:type list))
  (not nil)
  (value 0 :type (unsigned-byte 32)))

(defun consistentp (node-i nodes)
  (declare (optimize (speed 3) (debug 0) (safety 0)))
  (dolist (node-j nodes t)
    (when (or (= (the (unsigned-byte 32) (node-value node-j))
                 (the (unsigned-byte 32) (node-value node-i)))
              (find (the (unsigned-byte 32) (node-value node-i))
                    (node-not node-j)
                    :test #'=))
      (return-from consistent-p nil))))

CL-USER> (lisp-implementation-version)
"19a"

CL-USER> (lisp-implementation-type)
"CMU Common Lisp"

CL-USER> (profile:profile-all)
NIL
CL-USER> (dotimes (n 100000)
           (consistentp '(NIL 77)
                         '(((56) 71) ((57 63) 67) ((58 64 68) 66) ((62
68 69 70) 65)
                           ((68 74 75 76 80) 59) ((26 5 6 7 2 17) 47)
((8 14 15 16 11 26 29) 38)
                           ((11 26 18 19 23 2 41 50) 35) ((14 20 21 22
26 5 44 53 29) 32)
                           ((15 21 25 26 18 6 36 45 30 33) 28) ((16 22
26 24 19 7 37 46 31 34 29) 27)
                           ((30 36 40 41 42 48 60 69 72 75 79 80) 13)
                           ((31 37 41 39 43 49 61 70 73 76 80 78 14)
12)
                           ((33 39 43 44 36 51 54 63 75 78 73 74 16 17)
10)
                           ((34 40 44 42 37 52 55 64 76 79 74 72 17 15
11) 9)
                           ((39 45 49 50 51 30 69 78 54 57 61 62 22 23
25 26) 4)
                           ((40 46 50 48 52 31 70 79 55 58 62 60 23 21
26 24 5) 3)
                           ((42 48 52 53 45 33 63 72 57 60 55 56 25 26
19 20 7 8) 1)
                           ((43 49 53 51 46 34 64 73 58 61 56 54 26 24
20 18 8 6 2) 0))))
NIL
CL-USER> (profile:report-time)
  Consed    |   Calls   |    Secs   | Sec/Call  | Bytes/C.  | Name:
-----------------------------------------------------------------------
152,121,056 |   100,000 |     7.300 |   0.00007 |     1,521 |
CONSISTENTP
-------------------------------------------------------------------
152,121,056 |   100,000 |     7.300 |           |           | Total

26 functions were not called.  See profile::*no-calls* for a list
; No value
From: Juho Snellman
Subject: Re: Why is this consing?!
Date: 
Message-ID: <slrndruv29.smr.jsnell@sbz-30.cs.Helsinki.FI>
<··········@gmail.com> wrote:
> Anyone care to give me some pointers on how to figure out why this
> function, consistentp, is consing ...
[...]
>               (find (the (unsigned-byte 32) (node-value node-i))
>                     (node-not node-j)
>                     :test #'=))

FIND indirectly calls a function that takes &rest arguments (#'=).
Since CMUCL doesn't support allocation of &rest lists on the stack by
default, the list needs to be consed.

One workaround is to use a non-variadic function as the :TEST.

  (find (the (unsigned-byte 32) (node-value node-i))
        (node-not node-j)
        :test (lambda (a b) (= a b)))

-- 
Juho Snellman
From: John Thingstad
Subject: Re: Why is this consing?!
Date: 
Message-ID: <op.s20wqizvpqzri1@mjolner.upc.no>
On Sat, 07 Jan 2006 09:31:05 +0100, Juho Snellman <······@iki.fi> wrote:

Wow! That was an eye opener.
I never realized the potentially huge gains in performance
that can be achieved by putting rest aguments on the stack before..

> <··········@gmail.com> wrote:
>> Anyone care to give me some pointers on how to figure out why this
>> function, consistentp, is consing ...
> [...]
>>               (find (the (unsigned-byte 32) (node-value node-i))
>>                     (node-not node-j)
>>                     :test #'=))
>
> FIND indirectly calls a function that takes &rest arguments (#'=).
> Since CMUCL doesn't support allocation of &rest lists on the stack by
> default, the list needs to be consed.
>
> One workaround is to use a non-variadic function as the :TEST.
>
>   (find (the (unsigned-byte 32) (node-value node-i))
>         (node-not node-j)
>         :test (lambda (a b) (= a b)))
>



-- 
Using Opera's revolutionary e-mail client: http://www.opera.com/mail/
comp.lang.lisp / 2006 / jan