On 13 Jan 2003, Gerd Moellmann wrote:
> Thomas Fischbacher <[EMAIL PROTECTED]> writes:
>
> > *What* is going on here?
>
> I guess I'd check if the uses of THE result in type checks being
> generated.
If so, then this would perhaps be a bug, according to cmu-user.ps, 4.7.1:
"If safety is 0, then no run-time error checking is done. In addition to
suppressing type checks, 0 also suppresses argument-count checking,
unbound-symbol checking and array bounds checks".
> If yes, you could declaim higher SPEED settings and/or
> lower SAFETY settings; don't remember when the type checks will be
> omitted.
>
> (Or use TRULY-THE,
No big difference:
(defmacro i+ (&rest args)
`(truly-the fixnum (+ ,@(mapcar #'(lambda (x) `(truly-the fixnum ,x))
args))))
(...)
Evaluation took:
9.76 seconds of real time
9.61 seconds of user run time
0.15 seconds of system run time
[Run times include 0.06 seconds GC run time]
0 page faults and
103902584 bytes consed.
Still about a factor 2.
> or get rid of the THEs by declaring variables
> properly and using standard macros...)
Okay, let us get rid of all this and *only* change the
(make-array rank :initial-element 0) to
(make-array rank :element-type 'fixnum :initial-element 0):
this still induces this huge performance penalty:
===========================================================================
(defvar E8 `((:cartan . ,(make-array '(8 8) :element-type 'fixnum :initial-contents
'(( 2 -1 0 0 0 0 0 0)
(-1 2 -1 0 0 0 0 0)
( 0 -1 2 -1 0 0 0 0)
( 0 0 -1 2 -1 0 0 0)
( 0 0 0 -1 2 -1 0 -1)
( 0 0 0 0 -1 2 -1 0)
( 0 0 0 0 0 -1 2 0)
( 0 0 0 0 -1 0 0 2)))) (:rank . ,8)))
(defun Cartan->PosRoots-v3 (group)
(declare (optimize (safety 0) (speed 3)))
(let* ((cartan (cav group :cartan))
(rank (cav group :rank))
(pos-roots (make-hash-table :test 'equalp))
(last-roots '())
(levels '(0))
(num rank)
)
;;
(dotimes (j rank)
(let ((simp-root (make-array rank :initial-element 0)))
(setf (aref simp-root j) 1)
(setf (hv pos-roots simp-root) j)
;; (ppush simp-roots simp-root)
(ppush last-roots simp-root)))
;;
;;(labels ((traverse (level)
(do ((level 1 (1+ level)))
((or
(<= num (car levels))
))
(ppush levels num)
(let ((new-roots '()))
(dolist (old-root (nreverse last-roots))
(let ((old-root-vee (array*vector cartan old-root)))
(dotimes (j rank)
(cond
((< (aref old-root-vee j)
(labels
((traverse (older-root p)
(decf (aref older-root j))
(cond ((hv pos-roots older-root)
(traverse older-root (1+ p)))
(t p))))
(traverse (copy-seq old-root) 0)))
(let ((new-root (copy-seq old-root)))
(incf (aref new-root j))
(cond
((not (hv pos-roots new-root))
(incf num)
(setf (hv pos-roots new-root) num)
(ppush new-roots new-root)))))))));;dolist
(setq last-roots new-roots))
)
;;
`((:rank . ,rank) (:cartan . ,cartan) (:pos-roots . ,pos-roots) (:levels .
,levels))))
(defun Cartan->PosRoots-v4 (group)
(declare (optimize (safety 0) (speed 3)))
(let* ((cartan (cav group :cartan))
(rank (cav group :rank))
(pos-roots (make-hash-table :test 'equalp))
(last-roots '())
(levels '(0))
(num rank)
)
;;
(dotimes (j rank)
(let ((simp-root (make-array rank :element-type 'fixnum :initial-element 0)))
(setf (aref simp-root j) 1)
(setf (hv pos-roots simp-root) j)
;; (ppush simp-roots simp-root)
(ppush last-roots simp-root)))
;;
;;(labels ((traverse (level)
(do ((level 1 (1+ level)))
((or
(<= num (car levels))
))
(ppush levels num)
(let ((new-roots '()))
(dolist (old-root (nreverse last-roots))
(let ((old-root-vee (array*vector cartan old-root)))
(dotimes (j rank)
(cond
((< (aref old-root-vee j)
(labels
((traverse (older-root p)
(decf (aref older-root j))
(cond ((hv pos-roots older-root)
(traverse older-root (1+ p)))
(t p))))
(traverse (copy-seq old-root) 0)))
(let ((new-root (copy-seq old-root)))
(incf (aref new-root j))
(cond
((not (hv pos-roots new-root))
(incf num)
(setf (hv pos-roots new-root) num)
(ppush new-roots new-root)))))))));;dolist
(setq last-roots new-roots))
)
;;
`((:rank . ,rank) (:cartan . ,cartan) (:pos-roots . ,pos-roots) (:levels .
,levels))))
#|
* (time (i-dotimes (j 1000) (cartan->posroots-v3 e8)))
Evaluation took:
5.21 seconds of real time
5.08 seconds of user run time
0.15 seconds of system run time
[Run times include 0.06 seconds GC run time]
1808 page faults and
84952880 bytes consed.
NIL
* (time (i-dotimes (j 1000) (cartan->posroots-v4 e8)))
Evaluation took:
10.12 seconds of real time
10.0 seconds of user run time
0.12 seconds of system run time
[Run times include 0.09 seconds GC run time]
0 page faults and
103909296 bytes consed.
|#
