We were asked to write a procedure that when given a list it will replace the first occurrence of a given element and only the first, but the catch is to write in CPS style. We are unable to turn it to CPS style written procedure that is given a success-cont and fail-cont..
If anyone is willing to give it a try we will really appreciate it :]
The procedure we have (graciously provided by answers here):
(define (replace-one list old new)
(cond ((pair? list)
(let ((next (replace-one (car list) old new)))
(cons next
(if (equal? next (car list)) ; changed?
(replace-one (cdr list) old new) ; no, recurse on rest
(cdr list))))) ; yes, done
((eq? list old) new)
(else list)))
EDITED
A big thanks to @WillNess for pointing out and fixing a bug, lurking in the original code. Here's a corrected implementation based on his code (with stepwise derivation), commented and made idiomatic for Racket:
(define (replace-one lst a b)
(let loop ([lst lst] ; input list
[f #f] ; have we made the first replacement?
[k (lambda (ls f) ls)]) ; continue with results: list and flag
(cond
(f ; replaced already:
(k lst f)) ; continue without changing anything
((empty? lst) ; empty list case
(k lst f)) ; go on with empty lst and flag as is
((not (pair? lst)) ; - none replaced yet - is this an atom?
(if (eq? lst a) ; is this the atom being searched?
(k b #t) ; replace, continue with updated flag
(k lst f))) ; no match, continue
(else ; is this a list?
(loop (first lst) ; process the `car` of `lst`
f ; according to flag's value, and then
(lambda (x f) ; accept resulting list and flag, and
(loop (rest lst) ; process the `cdr` of `lst`
f ; according to new value of flag,
(lambda (y f) ; getting the results from that, and then
(if f ; - if replacement was made -
(k ; continuing with new list, built from
(cons x y) ; results of processing the two branches,
f) ; and with new flag, or with
(k lst f)))))))))) ; the old list if nothing was changed
Notice that a single success continuation is used (called k in the code above) which accepts two resulting values: the list and the flag. The initial continuation just returns the final resulting list, and discards the final flag value. We could also return the flag, as indication of whether the replacement have been made at all or not. It is used internally to preserve as much of original list structure as possible, as usual with persistent data types (as seen in this answer).
Finally, always test your code:
; fixed, this wasn't working correctly
(replace-one '((((1 2) 3 4) a) 6) 'a 'b)
=> '((((1 2) 3 4) b) 6)
(replace-one '(((-))) '- '+)
=> '(((+)))
(replace-one '((-) - b) '- '+)
=> '((+) - b)
(replace-one '(+ 1 2) '+ '-)
=> '(- 1 2)
(replace-one '((+) 1 2) '+ '-)
=> '((-) 1 2)
(replace-one '(1 2 ((+)) 3 4) '+ '-)
=> '(1 2 ((-)) 3 4)
(replace-one '() '+ '-)
=> '()
(replace-one '(1 2 ((((((+ 3 (+ 4 5)))))))) '+ '-)
=> '(1 2 ((((((- 3 (+ 4 5))))))))
The OP asks for a transformation with two continuations - success and failure. This is easy enough to do: we start with a CPS version of deep-copy (car-cdr recursion), as usual, and then we just imagine that we have two ways to return a value: when we've just found the old value, so we return the new one instead and will stop looking any further; and if we didn't find it yet - in which case we return what we have and will keep looking for it.
;; replace first occurence of a inside xs with b,
;; using two continuations - success and failure
(define (rplac1_2 xs a b)
(let g ((xs xs)
(s (lambda (x) x)) ; s is "what to do on success"
(f (lambda () xs))) ; f is "what to do on failure"
(cond
((null? xs)
(f)) ; nowhere to look for `a` anymore
((not (pair? xs))
(if (eq? xs a)
(s b) ; success: `a` found: "return" `b` instead
(f))) ; nowhere to look for `a` anymore
(else
(g (car xs)
(lambda (x) ; if succeded on (car xs), with `x` the result
(s (cons x (cdr xs))))
(lambda () ; if failed (nothing replaced yet, keep trying)
(g (cdr xs)
(lambda (y) ; if succeeded on (cdr xs), with `y` the result
(s (cons (car xs) y)))
f))))))) ; if none replaced
this way we're practically forced to preserve the original list structure as much as possible.
Testing it with
(display (rplac1_2 '((((a 2) 3 4) a) 6) 'a 'b))
(display (rplac1_2 '((((c 2) 3 4) a) 6) 'a 'b))
(display (rplac1_2 '((((c 2) 3 a) a) 6) 'a 'b))
correctly produces
((((b 2) 3 4) a) 6)
((((c 2) 3 4) b) 6)
((((c 2) 3 b) a) 6)
来源：https://stackoverflow.com/questions/16550176/changing-a-function-into-cps-style