2 ;;;; compiler-extras.lisp
4 ;;;; hold things that I (WHN) am working on which are sufficiently
5 ;;;; closely tied to the system that they want to be under the same
6 ;;;; revision control, but which aren't yet ready for prime time.
8 ;;;; Unless you like living dangerously, you don't want to be running
9 ;;;; these. But there might be some value to looking at these files to
10 ;;;; see whether I'm working on optimizing something whose performance
11 ;;;; you care about, so that you can patch it, or write test cases for
12 ;;;; it, or pester me to release it, or whatever.
14 ;;;; Throughout 0.6.x, these were mostly performance fixes. Fixes for
15 ;;;; logical bugs tend to go straight into the system, but fixes for
16 ;;;; performance problems can easily introduce logical bugs, and no
17 ;;;; one's going to thank me for prematurely replacing old slow
18 ;;;; correct code with new fast code that I haven't yet discovered to
23 (declaim (optimize (speed 1) (space 2)))
25 ;;; TO DO for DEFTRANSFORM FILL:
26 ;;; ?? This DEFTRANSFORM, and the old DEFTRANSFORMs, should only
27 ;;; apply when SPEED > SPACE.
28 ;;; ?? Add test cases.
30 #+nil
; not tested yet..
31 (deftransform replace
((seq1 seq2
&key
(start1 0) end1
(start2 0) end2
)
33 (:start1 index
) (:end1
(or index null
))
34 (:start2 index
) (:end2
(or index null
)))
36 ;; This is potentially an awfully big transform
37 ;; (if things like (EQ SEQ1 SEQ2) aren't known
38 ;; at runtime). We need to make it available
39 ;; inline, since otherwise there's no way to do
40 ;; it efficiently on all array types, but it
41 ;; probably doesn't belong inline all the time.
42 :policy
(> speed
(1+ space
)))
44 (let ((et1 (upgraded-element-type-specifier-or-give-up seq1
))
45 (et2 (upgraded-element-type-specifier-or-give-up seq2
)))
46 `(let* ((n-copied (min (- end1 start1
) (- end2 start2
)))
47 (effective-end1 (+ start1 n-copied
)))
49 (with-array-data ((seq seq1
)
50 (start (min start1 start2
))
51 (end (max end1 end2
)))
52 (declare (type (simple-array ,et1
1) seq
))
53 (if (<= start1 start2
)
54 (let ((index2 start2
))
55 (declare (type index index2
))
56 (loop for index1 of-type index
57 from start1 below effective-end1 do
58 (setf (aref seq index1
)
61 (let ((index2 (1- end2
)))
62 (declare (type (integer -
2 #.most-positive-fixnum
) index2
))
63 (loop for index1 of-type index-or-minus-1
64 from
(1- effective-end1
) downto start1 do
65 (setf (aref seq index1
)
68 (with-array-data ((seq1 seq1
) (start1 start1
) (end1 end1
))
69 (declare (type (simple-array ,et1
1) seq1
))
70 (with-array-data ((seq2 seq2
) (start2 start2
) (end2 end2
))
71 (declare (type (simple-array ,et2
1) seq2
))
72 (let ((index2 start2
))
73 (declare (type index index2
))
74 (loop for index1 of-type index
75 from start1 below effective-end1 do
76 (setf (aref seq index1
)