mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-18 21:29:18 +02:00
65 lines
1.8 KiB
Scheme
65 lines
1.8 KiB
Scheme
;;; This code is
|
|
;;; Copyright (c) 1998 by Olin Shivers.
|
|
;;; The terms are: You may do as you please with this code, as long as
|
|
;;; you do not delete this notice or hold me responsible for any outcome
|
|
;;; related to its use.
|
|
;;;
|
|
;;; Blah blah blah. Don't you think source files should contain more lines
|
|
;;; of code than copyright notice?
|
|
|
|
(define (vector-portion-copy vec start end)
|
|
(let* ((len (vector-length vec))
|
|
(new-len (- end start))
|
|
(new (make-vector new-len)))
|
|
(do ((i start (+ i 1))
|
|
(j 0 (+ j 1)))
|
|
((= i end) new)
|
|
(vector-set! new j (vector-ref vec i)))))
|
|
|
|
(define (vector-copy vec)
|
|
(vector-portion-copy vec 0 (vector-length vec)))
|
|
|
|
(define (vector-portion-copy! target src start end)
|
|
(let ((len (- end start)))
|
|
(do ((i (- len 1) (- i 1))
|
|
(j (- end 1) (- j 1)))
|
|
((< i 0))
|
|
(vector-set! target i (vector-ref src j)))))
|
|
|
|
(define (has-element list index)
|
|
(cond
|
|
((zero? index)
|
|
(if (pair? list)
|
|
(values #t (car list))
|
|
(values #f #f)))
|
|
((null? list)
|
|
(values #f #f))
|
|
(else
|
|
(has-element (cdr list) (- index 1)))))
|
|
|
|
(define (list-ref-or-default list index default)
|
|
(call-with-values
|
|
(lambda () (has-element list index))
|
|
(lambda (has? maybe)
|
|
(if has?
|
|
maybe
|
|
default))))
|
|
|
|
(define (vector-start+end vector maybe-start+end)
|
|
(let ((start (list-ref-or-default maybe-start+end
|
|
0 0))
|
|
(end (list-ref-or-default maybe-start+end
|
|
1 (vector-length vector))))
|
|
(values start end)))
|
|
|
|
(define (vectors-start+end-2 vector-1 vector-2 maybe-start+end)
|
|
(let ((start-1 (list-ref-or-default maybe-start+end
|
|
0 0))
|
|
(end-1 (list-ref-or-default maybe-start+end
|
|
1 (vector-length vector-1)))
|
|
(start-2 (list-ref-or-default maybe-start+end
|
|
2 0))
|
|
(end-2 (list-ref-or-default maybe-start+end
|
|
3 (vector-length vector-2))))
|
|
(values start-1 end-1
|
|
start-2 end-2)))
|