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

; procedure: substring::safe-copy!
; arguments: from-string from-start from-end to-string to-start
; signature: string x integer x integer x string x integer -> unspecified
; pre:       (or (not (eq? from-string to-string))
;                (not (<= from-start to-start from-end)))
;
; Copies (- FROM-END FROM-START) characters from FROM-STRING to
; TO-STRING placing them in TO-STRING starting at position TO-START.
;
; On bounds error SUBSTRING:ERROR:BOUNDS is called.

(define substring::safe-copy!
  (lambda (f fs fe t ts)
    (if (<= 0 fs fe (string-length f))
	(if (<= 0 ts (+ ts (- fe fs)) (string-length t))
	    (substring::unsafe-copy! f fs fe t ts)
	    (substring:error:bounds t ts (+ ts (- fe fs))))
	(substring:error:bounds f fs fe))))

;------------

; procedure: substring::unsafe-copy!
; arguments: from-string from-start from-end to-string to-start
; signature: string x integer x integer x string x integer -> unspecified
; pre: (and (<= 0 from-start from-end (string-length from-string))
;           (<= 0 to-start (string-length to-string)))

(define substring::unsafe-copy!
  (lambda (from-string from-start from-end to-string to-start)
    (let loop ((f from-start) (t to-start))
      (if (= f from-end)
	  #t				; arbitrary value
	  (begin
	    (string-set! to-string t (string-ref from-string f))
	    (loop (+ f 1) (+ t 1)))))))

; No bounds checking is done since this is a primitive routine.

;------------

;+doc
; procedure: substring:copy!
; arguments: from-string from-start from-end to-string to-start
; signature: string x integer x integer x string x integer -> unspecified
; pre:       (or (not (eq? from-string to-string))
;                (not (<= from-start to-start from-end)))
;
; Copies (- FROM-END FROM-START) characters from FROM-STRING to
; TO-STRING placing them in TO-STRING starting at position TO-START.
; The requirement that the two strings do are not equal, or don't
; overlap is to allow the copying process to be optimised.
;
; On bounds error SUBSTRING:ERROR:BOUNDS is called.
;-doc

(define substring:copy! substring::safe-copy!)

;-------------

;+doc
; procedure: substring:error:bounds
; arguments: string bounds
; signature: string . bounds -> unspecified
;
; Called on whenever an operation attempts to index outside the domain
; of STRING.  BOUNDS should be a list containing an erroneous bound.
; Redefine it as necessary.
;-doc

(define substring:error:bounds
  (lambda (string . bounds)
    (error 'substring:error:bounds "~s ~s" string bounds)))

;-------------

; eof
