; -*- Scheme -*-
;
; $Id: string19.scm,v 1.1 1998/03/16 07:59:41 foner Exp $

(require 'substring:copy!)

;+doc
; procedure: substring:replicate!
; arguments: source source-start source-end pattern pattern-start pattern-end
; signature: string x int x int x string x int x int -> unspecified
; pre: (and (<= 0 pattern-start pattern-end (string-length pattern))
;           (<= 0 source-start source-end (string-length source))
;           (<= 1 (- pattern-end pattern-start) (- source-end source-start))
;           (not (eq? source pattern)))
;
; Modifies SOURCE such that the characters between SOURCE-START
; (inclusive) and SOURCE-END (exclusive) are replaced by PATTERN from
; characters PATTERN-START (inclusive) to PATTERN-END (exclusive)
; repeated as many times as necessary. 
;
; > (define a "aaaaaaaaaa")
; > (define b "*|")
;
; > (substring:replicate! a 2 7 b 0 1)
; > a
; "aa*****aaa"
;
; > (substring:replicate! a 2 7 b 1 2)
; > a
; "aa|||||aaa"
;
; > (substring:replicate! a 2 7 b 0 2)
; > a
; "aa*|*|*aaa"
;-doc

(define substring:replicate!
  (lambda (s ss se p ps pe)
    (let* ((pl (- pe ps)))
      (let loop ((t ss) (n (+ ss pl)))
	(if (>= n se)
	    (substring:copy! p ps (+ ps (- se t)) s t)
	    (begin (substring:copy! p ps pe s t) (loop n (+ n pl))))))))

;+spec
; substring:replicate
; ext wr source        : Scheme-String
;     rd source-start  : Z
;     rd source-end    : Z
;     rd pattern       : Scheme-String
;     rd pattern-start : Z
;     rd pattern-end   : Z
; pre 0 <= pattern-start <= pattern-end <= len pattern
;  /\ 0 <= source-start <= source-end <= len source
;  /\ 1 <= pattern-end - patter-start <= source-end - source-start
;  /\ (* pattern <> source *)
; post let p  = pattern(pattern-start .. pattern-end)
;          sl = source-end - source-start
;          pl = pattern-end - pattern-start in
;      let p' = replicate(sl/pl + 1, p) in
;      let ss = old source(0 .. source-start)
;          sm = p'(0 .. sl)
;          se = old source(source-end .. len old source) in
;      source = ss^sm^se
;
; replicate :: Z x Scheme-String -> Scheme-String
; replicate(n, s) = if n = 0 then s else s^replicate(n-1,s)
;-spec

; eof
