#lang scheme/base (require (planet chongkai/sml/ml-package) scheme/match (only-in (planet chongkai/sml/ml-primitives) SOME? SOME SOME-content NONE? NONE Subscript? Subscript LESS? LESS EQUAL? EQUAL GREATER? GREATER)) (provide CharVector-struct) (define-package CharVector-struct (maxLen fromList tabulate length sub extract concat app map foldl foldr appi mapi foldli foldri) (define maxLen +inf.0) (define tabulate (match-lambda ((vector n f) (build-string n f)))) (define sub (match-lambda ((vector s i) (call-with-exception-handler (lambda (e) (if (exn:break? e) e (Subscript (current-continuation-marks)))) (lambda () (string-ref s i)))))) (define extract (match-lambda ((vector s i (? NONE?)) (call-with-exception-handler (lambda (e) (if (exn:break? e) e (Subscript (current-continuation-marks)))) (lambda () (substring s i)))) ((vector s i (? SOME? (app SOME-content j))) (call-with-exception-handler (lambda (e) (if (exn:break? e) e (Subscript (current-continuation-marks)))) (lambda () (substring s i j)))))) (define (concat l) (apply string-append l)) (define ((app f) s) (for-each f (string->list s))) (define ((map f) s) (list->string (map f (string->list s)))) (define ((appi f) s) (let ((stop (string-length s))) (let lp ((i 0)) (when (< i stop) (f (vector-immutable i (string-ref s i))) (lp (add1 i)))))) (define ((mapi f) s) (let* ((stop (string-length s)) (newstr (make-string stop))) (let lp ((j 0)) (when (< j stop) (string-set! newstr j (f (vector j (string-ref s j)))) (lp (add1 j)))) (string->immutable-string newstr))) (define (((foldli f) init) s) (let ((stop (string-length s))) (let lp ((i 0) (acc init)) (if (< i stop) (lp (add1 i) (f (vector-immutable i (string-ref s i) acc))) acc)))) (define (((foldri f) init) s) (let lp ((j (sub1 (string-length s))) (acc init)) (if (<= 0 j) (lp (sub1 j) (f (vector-immutable j (string-ref s j) acc))) acc))) (define (((foldl f) init) v) (let ((end (string-length v))) (let lp ((i 0) (acc init)) (if (< i end) (lp (add1 i) (f (vector (string-ref v i) acc))) acc)))) (define (((foldr f) init) v) (let lp ((i (sub1 (string-length v))) (acc init)) (if (negative? i) acc (lp (sub1 i) (f (vector (string-ref v i) acc)))))) (define fromList list->string) (define* length string-length) )