#lang racket

(define two 2)
(define four 4)

(define (exp1)
  (*
   (+ 1 2)
   (+ 3 4)))

(define (exp2)
  (*
   (+ 1 
      (call/cc 
       (lambda(x)
         (set! two x)
         2)))
   (+ 3 
      (call/cc
       (lambda(x)
         (set! four x)
         4)))))

(exp1)
(exp2)
(two 5)
(two 6)
(two 7)
(two 10)
(four 6)

(define (counter)
  (define local 0)
  (set! local
        (+ ; if the reference to local is moved here, the original value sits in the rts
           (call/cc
            (lambda (x)
              (set! counter x)
              0))
           local))
  local)

(define (atom? x)
  (and (not (pair? x))(not(null? x))))

; leftmost functions return the first atom going left-to-right
(define (leftmost3 l)
  (if (null? l)
      '() ; Empty list indicates local failure
      (let
          ((head (car l))
           (tail (cdr l)))
        (if (atom? head) 
            head ; Have result
            (let
                ((y (leftmost3 head))) ; Have to break down further
              (if (atom? y)
                  y  ; annoying check for completion
                  (leftmost3 tail)))))))

(leftmost3 '(((a b (c d)) e (f g))))

(leftmost3 '(((() () (c d)) e (f g))))

(define (leftmost6 l)
  (call/cc
   (lambda (skip)    ; skip is the name of a continuation that might be replaced with result
     (define (lm l)
       (if (null? l)
           '() ; Empty list indicates local failure
           (let
               ((head (car l))
                (tail (cdr l)))
             (if (atom? head) 
                 (skip head)  ; Have result, once and for all!!!
                 (begin
                   (lm head)        ; If this succeeds, will exit through skip
                   (lm tail))))))   ; Ditto . . .
     (lm l))))

(leftmost6 '(((a b (c d)) e (f g))))

(leftmost6 '(((() () (c d)) e (f g))))

; rember functions remove the first occurence of atom a going left-to-right 
(define (rember1* a l)
  (define (rm l)
    (if (null? l)
        '()     ; Nothing left to match against
        (let
            ((head (car l))
             (tail (cdr l)))
          (if (atom? head) 
              (if (eq? head a) 
                  tail      ; Found leftmost occurence, so remove it
                  (cons head (rm tail)))  ; Try tail
              (let ; Go deeper into head since it is a list
                  ((y (rm head)))
                (if (equal? y head)      ; These aren't cheap!  Checks if an atom was removed
                    (cons head (rm tail)) ; Did not find, so try in tail
                    (cons y tail)))))))  ; Leftmost occurence was removed to get y
  (rm l))

(rember1* 'x '(((y x (a b c d) (x y)))))

(rember1* 'z '(((y x (a b c d) (x y)))))

; Conceptually, this version has a stack of continuations to avoid atom removal checking
; but also allows consing results together
(define (rember2*c a l)
  (define (rm l oh1)  ; Passes back an atom if a is not found, otherwise a list without its first a
    (if (null? l)
        (oh1 'noAtom) ; failure indicated by returning an atom to continuation
        (let 
            ((head (car l))
             (tail (cdr l)))
          (if (atom? head)
              (if (eq? head a)
                  tail         ; return list without a 
                  (cons head   ; keep trying
                        (rm tail oh1)))
              (let 
                  ((new-head (call/cc   ; attempt on just the head of list
                              (lambda (oh2)
                                (rm head oh2)))))
                (if (atom? new-head)
                    (cons head    ; attempt on head failed, so try tail
                          (rm tail oh1))
                    (cons new-head tail)))))))  ; done, the fact that a list is returned flags success
  (let
      ((new-l (call/cc       ; attempt on the entire input list
               (lambda(oh3)
                 (rm l oh3)))))
    (if (atom? new-l)
        l        ; Never found a, original list is the result
        new-l))) ; Returned value is list without its first a occurence

(rember2*c 'x '(((y x (a b c d) (x y)))))

(rember2*c 'z '(((y x (a b c d) (x y)))))