#lang plai-typed

;; The `any-u-turns?' function takes a program and reports
;; whether it *definitely* makes any u-turns. A u-turn
;; is a turn in some direction, any number of straights, and
;; another turn in the same direction.

(define-type Step
  [left]
  [right]
  [forward (n : number)]
  [flip-coin (h : (listof Step))
             (t : (listof Step))])

;; A prev-turn is either 'left 'right 'none

;; A (listof Step) is either
;;  - empty
;;  - (cons [Step] [(listof Step)])

(define (u-turn? [s : Step] [prev : symbol])
  (type-case Step s
    [left () (eq? prev 'left)]
    [right () (eq? prev 'right)]
    [forward (n) false]
    [flip-coin (h t) (and (any-u-turns? h prev)  
                          (any-u-turns? t prev))]))
(module+ test
  (test (u-turn? (left) 'right)
        false)
  (test (u-turn? (left) 'left)
        true)
  (test (u-turn? (right) 'left)
        false)
  (test (u-turn? (forward 10) 'left)
        false)
  (test (u-turn? (flip-coin (list (left) (left)) (list (right) (right))) 'none)
        true))

(define (step->prev [s : Step] [prev : symbol]) : symbol
  (type-case Step s
    [left () 'left]
    [right () 'right]
    [forward (n) prev]
    [flip-coin (h t)
               ;; If `h' and `t' and with the same kind of
               ;; turn, then we always end with that kind of
               ;; turn. Otherwise, we're not forced into
               ;; an immediate u-turn.
               (local [(define h-prev (last-prev h prev))
                       (define t-prev (last-prev t prev))]
                 (cond
                   [(eq? h-prev t-prev) h-prev]
                   [else 'none]))]))

(module+ test
  (test (step->prev (left) 'none)
        'left)
  (test (step->prev (right) 'none)
        'right)
  (test (step->prev (forward 10) 'none)
        'none)
  (test (step->prev (forward 10) 'left)
        'left)
  (test (step->prev (flip-coin (list (left)) (list (forward 10))) 'left)
        'left)
  (test (step->prev (flip-coin (list (left)) (list (right))) 'left)
        'none))

(define (any-u-turns? [p : (listof Step)] [prev : symbol]) : boolean
  (cond
    [(empty? p) false]
    [(cons? p) (or (u-turn? (first p) prev)
                   (any-u-turns? (rest p) 
                                 (step->prev (first p) prev)))]))

(module+ test
  (test (any-u-turns? (list (right) (left) (forward 3)) 'none) 
        false)
  (test (any-u-turns? (list (right) (forward 3) (right)) 'none)
        true)
  (test (any-u-turns? empty 'none)
        false)
  (test (any-u-turns? (list (forward 42)) 'none) 
        false)
  (test (any-u-turns? (list (left)) 'left) 
        true)
  (test (any-u-turns? (list (left)) 'right) 
        false))


(define (last-prev [p : (listof Step)] [prev : symbol]) : symbol
  (cond
    [(empty? p) prev]
    [(cons? p) (last-prev (rest p)
                          (step->prev (first p) prev))]))

(module+ test
  (test (last-prev empty 'right) 'right))