home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / guile-ii.src / guile-ii / guile-src / slib / sc4opt.scm < prev    next >
Encoding:
Text File  |  1994-05-25  |  1.7 KB  |  54 lines
  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)))
  54.