diff --git a/s48/sequences/README b/s48/sequences/README index 9bb569d..ff3e63b 100644 --- a/s48/sequences/README +++ b/s48/sequences/README @@ -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. * diff --git a/s48/sequences/genseqs.scm b/s48/sequences/genseqs.scm index 38c2f37..29d6ebb 100644 --- a/s48/sequences/genseqs.scm +++ b/s48/sequences/genseqs.scm @@ -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)