scsh-conservatory
/
sunterlib
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

anti-aliasing fixes

This commit is contained in:
Rolf-Thomas Happe 2003-03-23 19:23:12 +00:00
parent 93f8fe8c5c
commit 81d87d51a9
2 changed files with 38 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
s48/sequences/README
View File

@ -101,7 +101,8 @@ The following kinds of sequences are supported by this facility:
Absequences carry a SEQUENCE-BEHAVIOR record that contains MAKER,
PREDICATE, etc. procedures. They are the official backdoor where
user-defined sequence types enter the general sequence lib. There are
Examples.
Examples. [ The Examples demonstrate how one might introduce hidden
aliasing, i.e. shared subsequences, and break some banged procedures ... ]
*
@ -299,6 +300,8 @@ S1 = < s0[start+i] : i in [0:end-start) >.
(sequence-copy! s1 start1 s0 [start0 end0]) --> unspec
Synopsis: Set s1[start1 + i] := s0[start0 + i] for 0 <= i < end0 - start0.
Assignment is parallel -- if there's no hidden aliasing (s1[j] and s0[k]
referring to the same location although j ~= k).
*
@ -373,6 +376,7 @@ arg. ]
Synopsis: Set s1[start1 + i] := (proc s0[start0 + i])
for 0 <= i < end1 - start1, return s1.
Assignment is parallel -- if there's no hidden aliasing.
Attention: differing from CL's MAP-INTO, these procs expect
end1 - start1 <= s0.length - start0, i.e. the destination S1 drives the
@ -390,6 +394,7 @@ Synopsis: Set s1[i] := (proc s00[i] ...) for i in [0:s1.length), return s1.
Attention: differing from CL's MAP-INTO, these procs expect the sequences
S00, ... to be no less long than the destination S1, like MAP! in SRFI-1.
Doesn't cope with absequent aliasing problems.
*

41
s48/sequences/genseqs.scm
View File

@ -80,16 +80,28 @@
s opts))
;; for internal use
(define (%sequence-copy! s1 start1 s0 start0 end0)
(if (<= start1 start0)
(do ((i0 start0 (+ i0 1))
(i1 start1 (+ i1 1)))
((= i0 end0) (unspecific))
(sequence-set! s1 i1 (sequence-ref s0 i0)))
(let ((end1 (+ start1 (- end0 start0))))
(do ((i0 (- end0 1) (- i0 1))
(i1 (- end1 1) (- i1 1)))
((= i0 (- start0 1)) (unspecific))
(sequence-set! s1 i1 (sequence-ref s0 i0))))))
(define (sequence-copy! s1 start1 s0 . opts)
(let-optionals opts ((start0 0) (end0 (sequence-length s0)))
(assert (<= 0 start0 end0 (sequence-length s0))
sequence-copy!)
(assert (<= 0 start1 (+ start1 (- end0 start0)) (sequence-length s1))
sequence-copy!)
(do ((i0 start0 (+ i0 1))
(i1 start1 (+ i1 1)))
((= i0 end0) (unspecific))
(sequence-set! s1 i1 (sequence-ref s0 i0)))))
(%sequence-copy! s1 start1 s0 start0 end0)
))
;; ...
(define (subsequence s start end)
@ -209,20 +221,31 @@
proc seq seqs))
;; for internal use
(define (%sequence-map-into! s1 proc s0 start1 end1 start0)
(if (<= start1 start0)
(do ((i0 start0 (+ i0 1))
(i1 start1 (+ i1 1)))
((= i1 end1) s1)
(sequence-set! s1 i1 (proc (sequence-ref s0 i0))))
(let ((end0 (+ start0 (- end1 start1))))
(do ((i0 (- end0 1) (- i0 1))
(i1 (- end1 1) (- i1 1)))
((= i0 (- start0 1)) s1)
(sequence-set! s1 i1 (proc (sequence-ref s0 i0)))))))
(define (sequence-map-into! s1 proc s0 . opts)
(let-optionals opts ((start1 0)
(end1 (sequence-length s1))
(start0 0))
(assert (<= 0 start0 (sequence-length s0))
sequence-map-into!)
(assert (<= 0 start1 (sequence-length s1))
(assert (<= 0 start1 end1 (sequence-length s1))
sequence-map-into!)
(assert (<= (- end1 start1) (- (sequence-length s0) start0))
sequence-map-into!)
(do ((i0 start0 (+ i0 1))
(i1 start1 (+ i1 1)))
((= i1 end1) s1)
(sequence-set! s1 i1 (proc (sequence-ref s0 i0))))))
(%sequence-map-into! s1 proc s0 start1 end1 start0)))
(define (sequences-map-into! seq proc . seqs)