guile/module/slib/sc2.scm

;"sc2.scm" Implementation of rev2 procedures eliminated in subsequent versions.
; Copyright (C) 1991, 1993 Aubrey Jaffer.
;
;Permission to copy this software, to redistribute it, and to use it
;for any purpose is granted, subject to the following restrictions and
;understandings.
;
;1.  Any copy made of this software must include this copyright notice
;in full.
;
;2.  I have made no warrantee or representation that the operation of
;this software will be error-free, and I am under no obligation to
;provide any services, by way of maintenance, update, or otherwise.
;
;3.  In conjunction with products arising from the use of this
;material, there shall be no use of my name in any advertising,
;promotional, or sales literature without prior written consent in
;each case.

(define (substring-move-left! string1 start1 end1 string2 start2)
  (do ((i start1 (+ i 1))
       (j start2 (+ j 1))
       (l (- end1 start1) (- l 1)))
      ((<= l 0))
    (string-set! string2 j (string-ref string1 i))))

(define (substring-move-right! string1 start1 end1 string2 start2)
  (do ((i (+ start1 (- end1 start1) -1) (- i 1))
       (j (+ start2 (- end1 start1) -1) (- j 1))
       (l (- end1 start1) (- l 1)))
      ((<= l 0))
    (string-set! string2 j (string-ref string1 i))))

(define (substring-fill! string start end char)
  (do ((i start (+ i 1))
       (l (- end start) (- l 1)))
      ((<= l 0))
    (string-set! string i char)))

(define (string-null? str)
  (= 0 (string-length str)))

(define append!
  (lambda args
    (cond ((null? args) '())
	  ((null? (cdr args)) (car args))
	  ((null? (car args)) (apply append! (cdr args)))
	  (else
	   (set-cdr! (last-pair (car args))
		     (apply append! (cdr args)))
	   (car args)))))

;;;; need to add code for OBJECT-HASH and OBJECT-UNHASH

(define 1+
  (let ((+ +))
    (lambda (n) (+ n 1))))
(define -1+
  (let ((+ +))
    (lambda (n) (+ n -1))))

(define <? <)
(define <=? <=)
(define =? =)
(define >? >)
(define >=? >=)