(define 1- (cut - <> 1))
(define 1+ (cut + <> 1))

(define-syntax define-form
  (syntax-rules ()
    ((_ (name arg ...) form)
     (define-syntax name
       (syntax-rules ()
         ((_ arg ...) form))))))

(define-form (swap vec a b)
  (let ((tmp (vector-ref vec a)))
    (vector-set! vec a (vector-ref vec b))
    (vector-set! vec b tmp)))

(use srfi-27)
(define (shuffle deck)
  (let1 v (list->vector deck)
    (let loop ((lst '())
               (size (length deck)))
      (if (zero? size)
        lst
        (let1 rand (random-integer size)
          (swap v (1- size) rand)
          (loop (cons (vector-ref v (1- size)) lst)
                (1- size)))))))

(define (any-subsequence? preds lst)
  (letrec ((F (lambda (preds lst)
                (cond
                  ((null? preds) #t)
                  ((null? lst) #f)
                  (((car preds) (car lst)) (F (cdr preds) (cdr lst)))
                  (else #f)))))
    (let loop ((lst lst))
      (cond
        ((null? preds) #t)
        ((null? lst) #f)
        (((car preds) (car lst)) (or (F preds lst)
                                     (loop (cdr lst))))
        (else (loop (cdr lst)))))))

(define (deck->stream deck)
  (let ((deck deck))
    (lambda ()
      (if (null? deck)
        (values #f #f)
        (let ((top (car deck)))
          (set! deck (cdr deck))
          (values top #t))))))

(define (take/stream n stream)
  (let loop ((n n) (lst '()))
    (if (zero? n)
      (reverse lst)
      (loop (1- n) (cons (stream) lst)))))

(define (set-ref-proc lst index proc)
  (cond
    ((null? lst) '())
    ((zero? index) (cons (proc) (cdr lst)))
    (else (cons (car lst)
                (set-ref-proc (cdr lst) (1- index) proc)))))

(define Suits '(Diamond Club Heart Spade))
(define Courts '(A 2 3 4 5 6 7 8 9 10 J Q K))
(define make-card cons)
(define suit-of car)
(define court-of cdr)
(define (number->card n)
  (make-card (list-ref Suits  (quotient n 13))
             (list-ref Courts (modulo n 13))))
(define (red? suit)
  (or (eq? suit 'Diamond) (eq? suit 'Heart)))
(define (successor? pre suc)
  (any-subsequence? (list (cut eq? <> pre) (cut eq? <> suc)) Courts))

(define (read-elements)
  (read-from-string (string-append "(" (read-line) ")")))

(define (change-hand hand choices deck)
  (let loop ((hand hand) (choices choices))
    (if (null? choices)
      hand
      (loop (set-ref-proc hand (car choices) deck)
            (cdr choices)))))

(define (suit->string suit)
  (cadr (assoc suit '((Diamond "♢")
                      (Club "♣")
                      (Heart "♡")
                      (Spade "♠")))))

(define (print-hand hand)
  (for-each
    display
    (map (lambda (card)
           (string-append
             "["
             (suit->string (suit-of card))
             (x->string (court-of card))
             "]"))
         (map number->card hand)))
  (newline))

(random-source-randomize! default-random-source)
(define (main args)
  (and-let*
    ((deck (deck->stream (shuffle (iota 52))))
     (hand (take/stream 5 deck))
     (_ (print-hand hand))
     (choices (read-elements))
     (hand (change-hand hand choices deck))
     (_ (print-hand hand)))
    #f))