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

Last change on this file since 38874 was 38874, checked in by Kon Lovett, 2 months ago

add functor types include, note path-iterator bug

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 numeric-macros)
15(import type-checks)
16(import type-errors)
17
18(define-type sequence (or vector list string (struct shared-vector)))
19(include "levenshtein-sequence-interface.types")
20
21;;;
22
23(define (*vector-length vec)
24  (cond
25    ((vector? vec) (vector-length vec))
26    ((%shared-vector? vec) (- (%shared-vector-end vec) (%shared-vector-start vec)))
27    (else
28      (error/type/vector '*vector-length vec)) ) )
29
30(define (*vector-ref vec idx)
31  (cond
32    ((vector? vec) (vector-ref vec idx))
33    ((%shared-vector? vec)
34      (let ((ridx (+ (%shared-vector-start vec) idx)))
35        (if (and (<= (%shared-vector-start vec) ridx) (< ridx (%shared-vector-end vec)))
36            (*vector-ref (%shared-vector-vector vec) ridx)
37            (error 'vector-ref "out of range" idx))))
38    (else
39      (error/type/vector '*vector-ref vec)) ) )
40
41(define (*vector-for-each f vec . vectors)
42  (define (vec-for-each f vec start end)
43    (do ((i start (+ i 1)))
44        ((<= end i))
45      (f i (*vector-ref vec i)) ) )
46  (if (null? vectors)
47      (vec-for-each f vec 0 (*vector-length vec))
48      (error 'vector-for-each "multiple vector support not implemented") ) )
49
50(define (subvector/shared vec start #!optional (end (*vector-length vec)))
51  (%make-shared-vector vec start end) )
52
53(define (vector-prefix-length elm-eql v1 v2
54          #!optional (s1 0) (e1 (*vector-length v1)) (s2 0) (e2 (*vector-length v2)))
55  (let loop ((i1 s1) (i2 s2))
56    (cond
57      ((or (>= i1 e1) (>= i2 e2))
58        (if (> i1 e1) 0 (- i1 s1)))
59      ((elm-eql (*vector-ref v1 i1) (*vector-ref v2 i2))
60        (loop (++ i1) (++ i2)))
61      (else
62        (- i1 s1)))) )
63
64(define (vector-suffix-length elm-eql v1 v2
65          #!optional (s1 0) (e1 (*vector-length v1)) (s2 0) (e2 (*vector-length v2)))
66  (let loop ((i1 (-- e1)) (i2 (-- e2)))
67    (cond
68      ((or (<= i1 s1) (<= i2 s2))
69        (if (< i1 s1) 0 (- e1 (++ i1))))
70      ((elm-eql (*vector-ref v1 i1) (*vector-ref v2 i2))
71        (loop (-- i1) (-- i2)))
72      (else
73        (- e1 (++ i1))))) )
74
75;;;
76
77(define check-sequence check-vector)
78(define sequence-length vector-length)
79(define sequence-prefix-length vector-prefix-length)
80(define sequence-suffix-length vector-suffix-length)
81(define sequence-for-each vector-for-each)
82(define subsequence/shared subvector/shared)
83
84) ;module levenshtein-sequence-vector
Note: See TracBrowser for help on using the repository browser.