source: project/release/5/levenshtein/trunk/levenshtein-sequence-vector.scm @ 38890

Last change on this file since 38890 was 38890, checked in by Kon Lovett, 8 weeks ago

rm dep

File size: 2.6 KB
Line 
1;;;; levenshtein-sequence-vector.scm -*- Scheme -*-
2;;;; Kon Lovett, Mar '20
3;;;; Kon Lovett, Apr '12
4;;;; Kon Lovett, May '06
5
6(include "levenshtein-sequence-interface")
7
8(module levenshtein-sequence-vector SEQUENCE-OPER
9
10(import scheme)
11(import (chicken base))
12(import (chicken type))
13(import vector-lib)
14(import type-checks)
15(import type-errors)
16
17(define-type sequence (or vector list string (struct shared-vector)))
18(include "levenshtein-sequence-interface.types")
19
20;;;
21
22(define (*vector-length vec)
23  (cond
24    ((vector? vec) (vector-length vec))
25    ((%shared-vector? vec) (- (%shared-vector-end vec) (%shared-vector-start vec)))
26    (else
27      (error/type/vector '*vector-length vec)) ) )
28
29(define (*vector-ref vec idx)
30  (cond
31    ((vector? vec) (vector-ref vec idx))
32    ((%shared-vector? vec)
33      (let ((ridx (+ (%shared-vector-start vec) idx)))
34        (if (and (<= (%shared-vector-start vec) ridx) (< ridx (%shared-vector-end vec)))
35            (*vector-ref (%shared-vector-vector vec) ridx)
36            (error 'vector-ref "out of range" idx))))
37    (else
38      (error/type/vector '*vector-ref vec)) ) )
39
40(define (*vector-for-each f vec . vectors)
41  (define (vec-for-each f vec start end)
42    (do ((i start (+ i 1)))
43        ((<= end i))
44      (f i (*vector-ref vec i)) ) )
45  (if (null? vectors)
46      (vec-for-each f vec 0 (*vector-length vec))
47      (error 'vector-for-each "multiple vector support not implemented") ) )
48
49(define (subvector/shared vec start #!optional (end (*vector-length vec)))
50  (%make-shared-vector vec start end) )
51
52(define (vector-prefix-length elm-eql v1 v2
53          #!optional (s1 0) (e1 (*vector-length v1)) (s2 0) (e2 (*vector-length v2)))
54  (let loop ((i1 s1) (i2 s2))
55    (cond
56      ((or (>= i1 e1) (>= i2 e2))
57        (if (> i1 e1) 0 (- i1 s1)))
58      ((elm-eql (*vector-ref v1 i1) (*vector-ref v2 i2))
59        (loop (add1 i1) (add1 i2)))
60      (else
61        (- i1 s1)))) )
62
63(define (vector-suffix-length elm-eql v1 v2
64          #!optional (s1 0) (e1 (*vector-length v1)) (s2 0) (e2 (*vector-length v2)))
65  (let loop ((i1 (sub1 e1)) (i2 (sub1 e2)))
66    (cond
67      ((or (<= i1 s1) (<= i2 s2))
68        (if (< i1 s1) 0 (- e1 (add1 i1))))
69      ((elm-eql (*vector-ref v1 i1) (*vector-ref v2 i2))
70        (loop (sub1 i1) (sub1 i2)))
71      (else
72        (- e1 (add1 i1))))) )
73
74;;;
75
76(define check-sequence check-vector)
77(define sequence-length vector-length)
78(define sequence-prefix-length vector-prefix-length)
79(define sequence-suffix-length vector-suffix-length)
80(define sequence-for-each vector-for-each)
81(define subsequence/shared subvector/shared)
82
83) ;module levenshtein-sequence-vector
Note: See TracBrowser for help on using the repository browser.