From 81d87d51a97ccf016fc7c21668395131ffc3dfc8 Mon Sep 17 00:00:00 2001
From: Rolf-Thomas Happe <rthappe@web.de>
Date: Sun, 23 Mar 2003 19:23:12 +0000
Subject: [PATCH] anti-aliasing fixes

---
 s48/sequences/README      |  7 ++++++-
 s48/sequences/genseqs.scm | 41 ++++++++++++++++++++++++++++++---------
 2 files changed, 38 insertions(+), 10 deletions(-)

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)