Concurrency Control

; Lock manager simulation

(define locks (list)) ; list of (item . lock-type)

(define (can-grant? item lock-type)
  (let ((held (filter (lambda (l) (string=? (car l) item)) locks)))
    (cond
      ((null? held) #t)                              ; no lock held
      ((string=? lock-type "S")
       (not (member "X" (map cdr held))))             ; S ok if no X held
      (else #f))))                                    ; X needs no locks at all

(define (acquire item lock-type txn)
  (if (can-grant? item lock-type)
    (begin
      (set! locks (cons (cons item lock-type) locks))
      (display txn) (display " acquired ") (display lock-type)
      (display " on ") (display item) (newline))
    (begin
      (display txn) (display " BLOCKED on ") (display item) (newline))))

(acquire "A" "S" "T1")   ; granted
(acquire "A" "S" "T2")   ; granted (shared ok)
(acquire "A" "X" "T3")   ; blocked (X conflicts with S)
(newline)

(set! locks (list))       ; release all
(acquire "B" "X" "T1")   ; granted
(acquire "B" "S" "T2")   ; blocked (S conflicts with X)

; Two-phase locking: growing phase then shrinking phase.
; A transaction that violates 2PL can cause non-serializable schedules.

(define (simulate-2pl)
  (let ((phase "growing") (held (list)))
    (define (acquire lock)
      (if (string=? phase "growing")
        (begin
          (set! held (cons lock held))
          (display "  Acquire ") (display lock) (newline))
        (begin
          (display "  VIOLATION: cannot acquire in shrinking phase") (newline))))
    (define (release lock)
      (set! phase "shrinking")
      (set! held (filter (lambda (l) (not (string=? l lock))) held))
      (display "  Release ") (display lock) (newline))

    (display "Growing phase:") (newline)
    (acquire "A")
    (acquire "B")
    (acquire "C")
    (display "Shrinking phase:") (newline)
    (release "A")
    (release "B")
    ; Try acquiring in shrinking phase:
    (acquire "D")
    (release "C")))

(simulate-2pl)

# Deadlock detection via wait-for graph cycle detection

def detect_deadlock(waits_for):
    """waits_for: dict mapping txn -> set of txns it waits for"""
    def has_cycle(node, visited, stack):
        visited.add(node)
        stack.add(node)
        for neighbor in waits_for.get(node, set()):
            if neighbor not in visited:
                if has_cycle(neighbor, visited, stack):
                    return True
            elif neighbor in stack:
                return True
        stack.discard(node)
        return False

    visited = set()
    for txn in waits_for:
        if txn not in visited:
            if has_cycle(txn, visited, set()):
                return True
    return False

# No deadlock: T1 waits for T2
print("T1->T2:", detect_deadlock({"T1": {"T2"}}))

# Deadlock: T1 waits for T2, T2 waits for T1
print("T1->T2->T1:", detect_deadlock({"T1": {"T2"}, "T2": {"T1"}}))

# Three-way deadlock
print("T1->T2->T3->T1:", detect_deadlock({
    "T1": {"T2"}, "T2": {"T3"}, "T3": {"T1"}
}))

; MVCC simulation: each write creates a new version.
; Readers see the version valid at their start time.

(define versions (list))  ; list of (key timestamp value)

(define (mvcc-write key ts value)
  (set! versions (cons (list key ts value) versions))
  (display "  Write ") (display key) (display "=") (display value)
  (display " at t=") (display ts) (newline))

(define (mvcc-read key read-ts)
  ; Find latest version with timestamp <= read-ts
  (let loop ((vs versions) (best #f))
    (if (null? vs)
      (if best (caddr best) #f)
      (let ((v (car vs)))
        (if (and (string=? (car v) key)
                 (<= (cadr v) read-ts)
                 (or (not best) (> (cadr v) (cadr best))))
          (loop (cdr vs) v)
          (loop (cdr vs) best))))))

(mvcc-write "X" 1 100)
(mvcc-write "X" 3 200)
(mvcc-write "X" 5 300)
(newline)

; T1 started at t=2, sees version from t=1
(display "T1 (start t=2) reads X = ")
(display (mvcc-read "X" 2)) (newline)

; T2 started at t=4, sees version from t=3
(display "T2 (start t=4) reads X = ")
(display (mvcc-read "X" 4)) (newline)

; T3 started at t=6, sees version from t=5
(display "T3 (start t=6) reads X = ")
(display (mvcc-read "X" 6))