module/slib/sc4opt.scm

   1 ;"sc4opt.scm" Implementation of optional Scheme^4 functions for IEEE Scheme
   2 ;Copyright (C) 1991, 1993 Aubrey Jaffer.
   3 ;
   4 ;Permission to copy this software, to redistribute it, and to use it
   5 ;for any purpose is granted, subject to the following restrictions and
   6 ;understandings.
   7 ;
   8 ;1.  Any copy made of this software must include this copyright notice
   9 ;in full.
  10 ;
  11 ;2.  I have made no warrantee or representation that the operation of
  12 ;this software will be error-free, and I am under no obligation to
  13 ;provide any services, by way of maintenance, update, or otherwise.
  14 ;
  15 ;3.  In conjunction with products arising from the use of this
  16 ;material, there shall be no use of my name in any advertising,
  17 ;promotional, or sales literature without prior written consent in
  18 ;each case.
  19
  20 ;;; Some of these functions may be already defined in your Scheme.
  21 ;;; Comment out those definitions for functions which are already defined.
  22
  23 ;;; This code conforms to: William Clinger and Jonathan Rees, editors.
  24 ;;; Revised^4 Report on the Algorithmic Language Scheme.
  25
  26 (define (list-tail l p)
  27   (if (< p 1) l (list-tail (cdr l) (- p 1))))
  28
  29 (define (string->list s)
  30   (do ((i (- (string-length s) 1) (- i 1))
  31        (l '() (cons (string-ref s i) l)))
  32       ((< i 0) l)))
  33
  34 (define (list->string l) (apply string l))
  35
  36 (define string-copy string-append)
  37
  38 (define (string-fill! s obj)
  39   (do ((i (- (string-length s) 1) (- i 1)))
  40       ((< i 0))
  41       (string-set! s i obj)))
  42
  43 (define (list->vector l) (apply vector l))
  44
  45 (define (vector->list s)
  46   (do ((i (- (vector-length s) 1) (- i 1))
  47        (l '() (cons (vector-ref s i) l)))
  48       ((< i 0) l)))
  49
  50 (define (vector-fill! s obj)
  51   (do ((i (- (vector-length s) 1) (- i 1)))
  52       ((< i 0))
  53       (vector-set! s i obj)))