Greetings, and thanks!
The problem here is the slow coerce in 2.6.x:
(defun coerce (object type)
(when (typep object type)
;; Just return as it is.
(return-from coerce object))
(when (classp type)
(specific-error :wrong-type-argument "Cannot coerce ~S to class ~S~%"
object type))
(setq type (normalize-type type))
(case (car type)
(list
(do ((l nil (cons (elt object i) l))
(i (1- (length object)) (1- i)))
((< i 0) l)))
((array simple-array)
(unless (or (endp (cdr type))
(endp (cddr type))
(eq (caddr type) '*)
(endp (cdr (caddr type))))
(error "Cannot coerce to an multi-dimensional array."))
(do ((seq (make-sequence type (length object)))
(i 0 (1+ i))
(l (length object)))
((>= i l) seq)
(setf (elt seq i) (elt object i))))
(character (character object))
(float (float object))
((short-float) (float object 0.0S0))
((single-float double-float long-float) (float object 0.0L0))
(complex
(if (or (null (cdr type)) (null (cadr type)) (eq (cadr type) '*))
(complex (realpart object) (imagpart object))
(complex (coerce (realpart object) (cadr type))
(coerce (imagpart object) (cadr type)))))
(t (error "Cannot coerce ~S to ~S." object type))))
The elt usage effectively makes the loop quadratic.
Here is the version in 2.7.0, which still needs work, but will lilely be
noticeably better:
(defconstant +coerce-list+ '(list vector string array character short-float
long-float float complex function null cons))
(defun coerce (object type)
(declare (optimize (safety 1)))
(check-type type (and (not null) type-spec))
(when (typep-int object type)
(return-from coerce object))
(let ((tp (or (car (member (if (atom type) type (car type)) +coerce-list+))
(car (member type +coerce-list+ :test 'subtypep1)))))
(case tp
(function
(coerce
(cond ((symbolp object) (cond ((fboundp object) (symbol-function
object)) ((check-type-eval object type))))
((and (consp object) (eq (car object) 'lambda)) (values (eval
`(function ,object))))
((function-identifierp object) (coerce (get (cadr object)
'setf-function) tp))
((check-type-eval object type)))
type))
((null cons list)
(let* ((l (length object))
(x (sequence-type-length-type type)))
(when x (check-type l x))
(do ((ll nil (cons (aref object i) ll))
(i (1- l) (1- i)))
((< i 0) ll))))
((vector string array)
(let* ((l (length object))
(x (sequence-type-length-type type))
(v (typep object 'list)))
(when x (check-type-eval l x))
(do ((seq (make-sequence type l))
(i 0 (1+ i))
(p (and v object) (and p (cdr p))))
((>= i l) seq)
(setf (aref seq i) (if p (car p) (aref object i))))));;FIXME
(character (character object))
(short-float (float object 0.0S0))
(long-float (float object 0.0L0))
(float (float object))
(complex
(if (or (atom type) (null (cdr type)) (null (cadr type)) (eq (cadr type)
'*))
(complex (realpart object) (imagpart object))
(complex (coerce (realpart object) (cadr type))
(coerce (imagpart object) (cadr type)))))
(otherwise (check-type-eval object type)))))
(defun sequence-type-length-type-int (type)
(case (car type)
(cons (do ((i 0 (1+ i)) (x type (caddr type)))
((not (eq 'cons (car x)))
(cond ((equal x '(member nil)) `(eql ,i))
((not (equal x '(t))) `(eql ,(1+ i)))
('(integer 1)))) (declare (seqind i))))
(member (unless (cadr type) `(eql 0)))
(array (and (cddr type) (consp (caddr type)) (= (length (caddr type))
1) (integerp (caaddr type))
`(eql ,(caaddr type))))
((or and) (reduce (lambda (&rest xy) (when xy
(and (integerp (car xy))
(integerp (cadr xy))
(equal (car xy) (cadr
xy)) (car xy))))
(mapcar 'sequence-type-length-type-int (cdr
type))))))
(defun sequence-type-length-type (type)
(cond ((eq type 'null) `(eql 0));;FIXME accelerators
((eq type 'cons) `(integer 1))
((consp type) (sequence-type-length-type-int (normalize-type type)))))
Coerce is almost inlineable -- I just have to put in compile-time
evaluation of constant typed forms with no side effects.
At one time I experimented with elt keeping a static pointer to the
last cons to make it linear in the usual case of subsequent access,
but rejected it as too dangerous.
As you have a workaround, I can leave 2.6.8pre alone in this regard,
yes?
Take care,
Waldek Hebisch <[EMAIL PROTECTED]> writes:
> Bill Page wrote:
> > On 6/15/07, Waldek Hebisch wrote:
> > > On my machine, I get the following (on the second run, to
> > > exclude time for loading):
> > >
> > > gcl sbcl sbcl
> > > interpreted compiled
> > > reduce(+,[1.0/i for i in 1..20000]) 8.70 1.76 0.17
> > > [i for i in 1..20000]; 6.23 0.78 0.01
> > > expand(1..20000); 0 0.004 0.01
> > >
>
> > Waldek, thank you very much for running this comparison!
> >
> > So, the conclusion might be that I was wrong: the slowness *is*
> > because of the way that Axiom interpreter runs this code in
> > interpreted mode in GCL, right? It could still be that this interpreted
> > Lisp code is not written in an optimal manner.
> >
>
> As I wrote, it turned out that GCL interpreter is quite fast. After
> using modified LIST2VEC function (patch below, applied to wh-sandbox),
> I get the following timings:
>
> reduce(+,[1.0/i for i in 1..20000]) 0.69
> [i for i in 1..20000]; 0.09
>
> It seems that now significant part of execution time goes into
> floating point arithmetic.
>
> --- src/interp/vmlisp.lisp.pamphlet (wersja 606)
> +++ src/interp/vmlisp.lisp.pamphlet (kopia robocza)
> @@ -1107,8 +1107,21 @@
>
> (defun GETREFV (n) (make-array n :initial-element nil))
>
> +#-:GCL
> (defun LIST2VEC (list) (coerce list 'vector))
>
> +;;; At least in gcl 2.6.8 coerce is slow, so we roll our own version
> +#+:GCL
> +(defun LIST2VEC (list)
> + (if (consp list)
> + (let* ((len (length list))
> + (vec (make-array len)))
> + (dotimes (i len)
> + (setf (aref vec i) (pop list)))
> + vec)
> + (coerce list 'vector)))
> +
> +
> (define-function 'LIST2REFVEC #'LIST2VEC)
>
> ; 16.2 Accessing
>
> --
> Waldek Hebisch
> [EMAIL PROTECTED]
>
>
>
--
Camm Maguire [EMAIL PROTECTED]
==========================================================================
"The earth is but one country, and mankind its citizens." -- Baha'u'llah
_______________________________________________
Gcl-devel mailing list
Gcl-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/gcl-devel
