#lang scheme

(provide hackbot2)

;; Pseudo-Hackbot that gets cooperation from all the DegenerateMimics
(define hackbot2
  '(lambda (x)

     ;; Payload
     (define sub
       '(lambda (this y)

          ;; give me my source code
          (define quine-my-source
            (quasiquote (lambda (x)
                          (define sub (quote (unquote this)))
                          (define (ueval x)
                            (define ns (make-base-namespace))
                            (eval x ns))
                          ((ueval sub) sub x))))

          (define (ueval x)
            (define ns (make-base-namespace))
            (eval x ns))

          ;; Evaluates source code making every call to eval yield
          ;; so that recursive simulations will be sure to terminate in a timely manner
          (define (yield_eval x)
            (define (yield_eval0 expr ns)
              ;; Evaluation: first insert ourselves into the namespace
              (namespace-set-variable-value! 'eval yield_eval0 #t ns)
              (sleep 0)
              (eval expr ns))
            (define ns (make-base-namespace))
            (yield_eval0 x ns))

          ;; Evaluates source code assuming that we cooperate with the opponent
          (define (cval x)
            (define (cval0 expr ns)
              ;; Evaluation: first insert ourselves into the namespace
              (namespace-set-variable-value! 'eval cval0 #t ns)
              (sleep 0)
              ;; Then special case simulation of me against opponent
              (if (equal? expr quine-my-source)
                  (lambda (arg)
                    (if (equal? arg y)
                        'C
                        ((eval expr ns) arg)))
                  (eval expr ns)))
            (define ns (make-base-namespace))
            (cval0 x ns))

          ;; Execute code with a watchdog
          (define (timeout-exec seconds thunk default)
            (call-in-nested-thread (lambda ()
                                     (define mainthread (current-thread))
                                     (define execthread
                                       (thread (lambda ()
                                                 (thread-send mainthread (thunk)))))
                                     (define watchdog
                                       (thread (lambda ()
                                                 (sleep seconds)
                                                 (and (thread-running? execthread)
                                                      (begin (kill-thread execthread)
                                                             (and (thread-running? mainthread)
                                                                  (thread-send mainthread default)))))))
                                     (thread-receive))))

          ;; Simulate: a against b
          (define (timeout-fight a b default)
            (timeout-exec 0.5 (lambda () ((yield_eval a) b)) default))
          ;; Simulate: a against b assuming I cooperate
          (define (timeout-fight-c a b default)
            (timeout-exec 0.5 (lambda () ((cval a) b)) default))

          ;; cheap ruse to get around stupid TabooBots
          (define defect (ueval (read (open-input-string "(begin 'C 'D)"))))

          (define cbot '(lambda (z) 'C))
          (define defectbot (quasiquote (lambda (z) '(unquote defect))))
          (define stupidbot (quasiquote (lambda (z) (begin '(unquote defect) 'C))))

          (if (eq? (timeout-fight-c y quine-my-source defect) 'C)
              ;; They cooperate with us if we cooperate
              ;; Discarding the normal second test nets us cooperation from DegenerateMimics,
              ;; at the cost of having to cooperate with everything that cooperates...
              (if (and (eq? (timeout-fight y cbot 'C) 'C) (eq? (timeout-fight y stupidbot defect) defect))
                  ;; If they cooperate with CooperateBot, but defect
                  ;; against this stupid construction, they're probably a TabooBot
                  ;; Hence, exploitable
                  defect
                  'C)
              ;; Or, they defect against us if we cooperate
              ;; Obviously defect
              defect)))

     (define (ueval x)
       (define ns (make-base-namespace))
       (eval x ns))
     ((ueval sub) sub x)))