list.rkt (3567B)
1 #lang typed/racket 2 (require "typed-untyped.rkt") 3 (define-typed/untyped-modules #:no-test 4 (define-syntax (skip<=6.6 stx) 5 (syntax-case stx () 6 [(_ . rest) 7 (if (or (regexp-match #px"^6(\\.[012345](\\..*|)|)$" (version)) 8 (regexp-match #px"^6.6$" (version)) 9 (regexp-match #px"^[123245]\\..*$" (version))) 10 #'(begin) 11 #'(begin . rest))])) 12 13 (skip<=6.6 14 (provide replace-first)) 15 16 (provide indexof 17 map+fold 18 AListof 19 List3-Maybe 20 List3 21 Listof*) 22 23 (define-type (AListof K V) (Listof (Pairof K V))) 24 (define-match-expander alistof 25 (λ (stx) 26 (syntax-case stx () 27 [(keys-pat vals-pat) 28 #'(list (cons keys-pat vals-pat) …)]))) 29 30 (: indexof (∀ (A B) (->* [A (Listof B)] [(→ A B Any)] (U #f Integer)))) 31 (define (indexof elt lst [compare equal?]) 32 (let rec ([lst lst] [index 0]) 33 (if (null? lst) 34 #f 35 (if (compare elt (car lst)) 36 index 37 (rec (cdr lst) (+ index 1)))))) 38 39 (define-type (List3-Maybe Start Mid End) 40 (Listof* Start 41 (U Null 42 (Pairof Mid (Listof End))))) 43 44 (define-type (List3 Start Mid End) 45 (Listof* Start 46 (Pairof Mid (Listof End)))) 47 48 (define-type (Listof* Start End) 49 (Rec R (U (Pairof Start R) 50 End))) 51 52 (skip<=6.6 53 (: replace-first (∀ (A B1 B2 C D) 54 (case→ 55 (→ C 56 (Listof (U A B1)) 57 (→ (U A B1) Any : #:+ B1 #:- (! B1)) 58 (List3-Maybe A C (U A B1))) 59 (→ C 60 (Listof* A (U Null (Pairof B2 D))) 61 (→ (U A B2) Any : #:+ (! A) ;; ∴ (and (! A) B2) 62 #:- (! B2)) 63 (Listof* A (U Null (Pairof C D)))) 64 (→ C 65 (Listof* A (Pairof B2 D)) 66 (→ (U A B2) Any : #:+ (! A) ;; ∴ (and (! A) B2) 67 #:- (! B2)) 68 (Listof* A (Pairof C D))) 69 (→ C 70 (Listof A) 71 (→ (U A B1) Any) 72 (List3-Maybe A C (U A B1))) 73 (→ A 74 C 75 (Listof A) 76 (List3-Maybe A C (U A B1))) 77 (→ A 78 C 79 (Listof A) 80 (→ A (U A B1) Any) 81 (List3-Maybe A C (U A B1)))))) 82 (define (replace-first a1 a2 a3 [a4 eq?]) 83 (if (list? a3) 84 (replace-first a2 a3 (λ ([x : (U A B1)]) (a4 a1 x))) 85 (let ([to a1] 86 [pred? a3]) 87 (let rec ([l a2]) 88 (if (null? l) 89 '() 90 (if (pred? (car l)) 91 (cons to (cdr l)) 92 (cons (car l) 93 (rec (cdr l)))))))))) 94 95 (: map+fold (∀ (E R A) (→ (→ E A (values R A)) A (Listof E) 96 (Values (Listof R) A)))) 97 (define (map+fold f init-acc lst) 98 (if (null? lst) 99 (values '() init-acc) 100 (let*-values ([(item new-acc) (f (car lst) init-acc)] 101 [(new-lst last-acc) (map+fold f new-acc (cdr lst))]) 102 (values (cons item new-lst) 103 last-acc)))))