2 (require racket/control)
4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5 ;; solutions to the "abSdS" etc task ;;
6 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10 (define (saved z) (car z))
11 (define (nextchar z) (cadr z))
12 (define (rest z) (cddr z))
15 [(null? (cdr z)) (reverse (saved z))]
16 [(eqv? #\S (nextchar z)) (tz1 (pair (append (saved z) (saved z)) (rest z)))]
17 [else (tz1 (pair (cons (nextchar z) (saved z)) (rest z)))]))
19 ; using explicit continuations
22 [(null? l) (reverse (k '()))]
23 [(eqv? #\S (car l)) (tc0 (cdr l) (compose k k))]
24 [else (tc0 (cdr l) (lambda (tail) (cons (car l) (k tail))))]))
26 ; improvement: if we flip the order of cons and k in the last line, we can avoid the need to reverse
30 [(eqv? #\S (car l)) (tc1 (cdr l) (compose k k))]
31 [else (tc1 (cdr l) (lambda (tail) (k (cons (car l) tail))))]))
33 ; using implicit continuations (reset/shift)
38 [(eqv? #\S (car l)) ((compose k k) (tr1 (cdr l)))]
39 [else ((lambda (tail) (k (cons (car l) tail))) (tr1 (cdr l)))])))
41 ; wrapper functions, there's a (test) function at the end
44 (list->string (tz1 (cons '() (string->list s)))))
47 (list->string (tc1 (string->list s) identity)))
50 (list->string (reset (tr1 (string->list s)))))
52 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
53 ;; here are variants that only repeat from S back to the most recent # ;;
54 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
58 (define (saved z) (car z))
59 (define (nextchar z) (cadr z))
60 (define (rest z) (cddr z))
61 (define (pair x y) (cons x y))
63 [(null? (cdr z)) (reverse (saved z))]
64 [(eqv? #\# (nextchar z)) (append (reverse (saved z)) (tz3 (pair '() (rest z))))]
65 [(eqv? #\S (nextchar z)) (tz3 (pair (append (saved z) (saved z)) (rest z)))]
66 [else (tz3 (pair (cons (nextchar z) (saved z)) (rest z)))]))
68 ; using explicit continuations
72 [(eqv? #\# (car l)) (append (k '()) (tc3 (cdr l) identity))]
73 [(eqv? #\S (car l)) (tc3 (cdr l) (compose k k))]
74 [else (tc3 (cdr l) (lambda (tail) (k (cons (car l) tail))))]))
76 ; using implicit continuations (reset/shift)
80 [(null? l) (identity (k '()))]
81 [(eqv? #\# (car l)) (append (k '()) (reset (tr3 (cdr l))))]
82 [(eqv? #\S (car l)) ((compose k k) (tr3 (cdr l)))]
83 [else ((lambda (tail) (k (cons (car l) tail))) (tr3 (cdr l)))])))
86 (list->string (tz3 (cons '() (string->list s)))))
89 (list->string (tc3 (string->list s) identity)))
92 (list->string (reset (tr3 (string->list s)))))
94 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
97 (define (cmp t1 t2 inp)
98 (equal? (t1 inp) (t2 inp)))
100 (equal? (tz2 "abSd") "ababd")
101 (cmp (lambda (s) (list->string (tc0 (string->list s) identity))) tz2 "abSd")
104 (equal? (tz2 "aSbS") "aabaab")
105 (cmp (lambda (s) (list->string (tc0 (string->list s) identity))) tz2 "aSbS")
108 (equal? (tz4 "ab#ceSfSd") "abcecefcecefd")
109 (cmp tc4 tz4 "ab#ceSfSd")
110 (cmp tr4 tz4 "ab#ceSfSd")
111 (equal? (tz4 "ab#ceS#fSd") "abceceffd")
112 (cmp tc4 tz4 "ab#ceS#fSd")
113 (cmp tr4 tz4 "ab#ceS#fSd")