add cps_hint_*
[lambda.git] / topics / cps_hint_3.mdwn
diff --git a/topics/cps_hint_3.mdwn b/topics/cps_hint_3.mdwn
new file mode 100644 (file)
index 0000000..fa8b373
--- /dev/null
@@ -0,0 +1,40 @@
+This function is developed in *The Seasoned Schemer* pp. 84-89. It accepts an atom `a` and a list `lst` and returns `lst` with the leftmost occurrence of `a`, if any, removed. Occurrences of `a` will be found no matter how deeply embedded.
+
+       #lang racket
+       
+       (define (atom? x)
+         (and (not (pair? x)) (not (null? x))))
+       
+       (define gamma
+         (lambda (a lst)
+           (letrec ([aux (lambda (l k)
+                           (cond
+                             [(null? l) (k 'notfound)]
+                             [(eq? (car l) a) (cdr l)]
+                             [(atom? (car l)) (cons (car l) (aux (cdr l) k))]
+                             [else
+                              ; when (car l) exists but isn't an atom, we try to remove a from (car l)
+                              ; if we succeed we prepend the result to (cdr l) and stop
+                              (let ([car2 (let/cc k2
+                                            ; calling k2 with val will bind car2 to val and continue with the (cond ...) block below
+                                            (aux (car l) k2))])
+                                (cond
+                                  ; if a wasn't found in (car l) then prepend (car l) to the result of removing a from (cdr l)
+                                  [(eq? car2 'notfound) (cons (car l) (aux (cdr l) k))]
+                                  ; else a was found in (car l)
+                                  [else (cons car2 (cdr l))]))]))]
+                    [lst2 (let/cc k1
+                            ; calling k1 with val will bind lst2 to val and continue with the (cond ...) block below
+                            (aux lst k1))])
+             (cond
+               ; was no atom found in lst?
+               [(eq? lst2 'notfound) lst]
+               [else lst2]))))
+       
+       (gamma 'a '(((a b) ()) (c (d ()))))       ; ~~> '(((b) ()) (c (d ())))
+       (gamma 'a '((() (a b) ()) (c (d ()))))    ; ~~> '((() (b) ()) (c (d ())))
+       (gamma 'a '(() (() (a b) ()) (c (d ())))) ; ~~> '(() (() (b) ()) (c (d ())))
+       (gamma 'c '((() (a b) ()) (c (d ()))))    ; ~~> '((() (a b) ()) ((d ())))
+       (gamma 'c '(() (() (a b) ()) (c (d ())))) ; ~~> '(() (() (a b) ()) ((d ())))
+       (gamma 'x '((() (a b) ()) (c (d ()))))    ; ~~> '((() (a b) ()) (c (d ())))
+