--- /dev/null
+#lang racket
+(require racket/control)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; solutions to the "abSdS" etc task ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; using a list zipper
+(define (tz1 z)
+ (define (saved z) (car z))
+ (define (nextchar z) (cadr z))
+ (define (rest z) (cddr z))
+ (define pair cons)
+ (cond
+ [(null? (cdr z)) (reverse (saved z))]
+ [(eqv? #\S (nextchar z)) (tz1 (pair (append (saved z) (saved z)) (rest z)))]
+ [else (tz1 (pair (cons (nextchar z) (saved z)) (rest z)))]))
+
+; using explicit continuations
+(define (tc1 l k)
+ (cond
+ [(null? l) (reverse (k '()))]
+ [(eqv? #\S (car l)) (tc1 (cdr l) (compose k k))]
+ [else (tc1 (cdr l) (lambda (tail) (cons (car l) (k tail))))]))
+
+; using implicit continuations (reset/shift)
+(define (tr1 l)
+ (shift k
+ (cond
+ [(null? l) (reverse (k '()))]
+ [(eqv? #\S (car l)) ((compose k k) (tr1 (cdr l)))]
+ [else ((lambda (tail) (cons (car l) (k tail))) (tr1 (cdr l)))])))
+
+; wrapper functions, there's a (test) function at the end
+
+(define (tz2 s)
+ (list->string (tz1 (cons '() (string->list s)))))
+
+(define (tc2 s)
+ (list->string (tc1 (string->list s) identity)))
+
+(define (tr2 s)
+ (list->string (reset (tr1 (string->list s)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; here are variants that only repeat from S back to the most recent # ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; using a list zipper
+(define (tz3 z)
+ (define (saved z) (car z))
+ (define (nextchar z) (cadr z))
+ (define (rest z) (cddr z))
+ (define (pair x y) (cons x y))
+ (cond
+ [(null? (cdr z)) (reverse (saved z))]
+ [(eqv? #\# (nextchar z)) (append (reverse (saved z)) (tz3 (pair '() (rest z))))]
+ [(eqv? #\S (nextchar z)) (tz3 (pair (append (saved z) (saved z)) (rest z)))]
+ [else (tz3 (pair (cons (nextchar z) (saved z)) (rest z)))]))
+
+; using explicit continuations
+; there are several working solutions
+; but it's a bit tricky to get the reverses in the right place, and the order of appending right
+(define (tc3 l k)
+ (cond
+ [(null? l) (reverse (k '()))]
+ [(eqv? #\# (car l)) (append (reverse (k '())) (tc3 (cdr l) identity))]
+ [(eqv? #\S (car l)) (tc3 (cdr l) (compose k k))]
+ [else (tc3 (cdr l) (lambda (tail) (cons (car l) (k tail))))]))
+
+; using implicit continuations (reset/shift)
+(define (tr3 l)
+ (shift k
+ (cond
+ [(null? l) (reverse (k '()))]
+ [(eqv? #\# (car l)) (append (reverse (k '())) (reset (tr3 (cdr l))))]
+ [(eqv? #\S (car l)) ((compose k k) (tr3 (cdr l)))]
+ [else ((lambda (tail) (cons (car l) (k tail))) (tr3 (cdr l)))])))
+
+(define (tz4 s)
+ (list->string (tz3 (cons '() (string->list s)))))
+
+(define (tc4 s)
+ (list->string (tc3 (string->list s) identity)))
+
+(define (tr4 s)
+ (list->string (reset (tr3 (string->list s)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (test)
+ (define (cmp t1 t2 inp)
+ (equal? (t1 inp) (t2 inp)))
+ (and
+ (equal? (tz2 "abSd") "ababd")
+ (cmp tc2 tz2 "abSd")
+ (cmp tr2 tz2 "abSd")
+ (equal? (tz2 "aSbS") "aabaab")
+ (cmp tc2 tz2 "aSbS")
+ (cmp tr2 tz2 "aSbS")
+ (equal? (tz4 "ab#ceSfSd") "abcecefcecefd")
+ (cmp tc4 tz4 "ab#ceSfSd")
+ (cmp tr4 tz4 "ab#ceSfSd")
+ (equal? (tz4 "ab#ceS#fSd") "abceceffd")
+ (cmp tc4 tz4 "ab#ceS#fSd")
+ (cmp tr4 tz4 "ab#ceS#fSd")
+ ))