   to contain the provided genome."
   [push-state tape-index genome]
   (assoc-in push-state
-            [:gtm :tapes tape-index :contents]
+            [:gtm :tapes tape-index]
             (into (sorted-map)
                   (zipmap (iterate inc 0)
                           (map ensure-instruction-map genome)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gtm (genetic turing machine) instructions

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Instructions for moving GTM control from tape to tape. There is always an "active"
;; tape, to which some instructions refer implicitly. 

(define-registered ;; set active to tape0
  gtm_tape0
  ^{:stack-types [:gtm]}
  (fn [state]
    (if (:gtm state)
      (trace 'gtm_tape0
             (-> state
                 (assoc-in [:gtm :active] 0)))
      state)))

(define-registered ;; set active to tape1
  gtm_tape1
  ^{:stack-types [:gtm]}
  (fn [state]
    (if (:gtm state)
      (trace 'gtm_tape1
             (-> state
                 (assoc-in [:gtm :active] 1)))
      state)))

(define-registered ;; set active to tape2
  gtm_tape2
  ^{:stack-types [:gtm]}
  (fn [state]
    (if (:gtm state)
      (trace 'gtm_tape2
             (-> state
                 (assoc-in [:gtm :active] 2)))
      state)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Instructions for moving the read/write head on the primary tape.

(define-registered ;; move head on active tape to the left
  gtm_left
  ^{:stack-types [:gtm]}
  (fn [state]
    (if (:gtm state)
      (trace 'gtm_left
             (update-in state [:gtm :tapes (:active (:gtm state)) :position] dec))
      state)))

(define-registered ;; move head on active tape to the right
  gtm_right
  ^{:stack-types [:gtm]}
  (fn [state]
    (if (:gtm state)
      (trace 'gtm_right
             (update-in state [:gtm :tapes (:active (:gtm state)) :position] inc))
      state)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Instructions for reading/writing to tapes.

(define-registered ;; copy from active to tape 0
  gtm_copy
  ^{:stack-types [:gtm]}
  (fn [state]
    (if (and (:gtm state)
             (not (zero? (:active (:gtm state)))))
      (let [destination-tape (get (:tapes (:gtm state)) 0)
            destination-position (:position destination-tape)
            source (:active (:gtm state))
            source-tape (get (:tapes (:gtm state)) source)
            source-position (:position source-tape)
            source-instr-map (get (:contents source-tape) source-position)]
        (if source-instr-map
          (trace 'gtm_copy
                 (-> state
                     (assoc-in [:gtm :tapes 0 :contents destination-position] 
                               source-instr-map)
                     (update-in [:gtm :tapes 0 :position] inc)
                     (update-in [:gtm :tapes source :position] inc)))
          state))
      state)))

(define-registered ;; push boolean indicating whether active tape is blank at current position
  gtm_blank
  ^{:stack-types [:gtm :boolean]}
  (fn [state]
    (if (:gtm state)
      (let [active (:active (:gtm state))
            active-tape (get (:tapes (:gtm state)) active)]
        (trace 'gtm_blank
               (update-in
                 (push-item (if (get (:contents active-tape) (:position active-tape))
                              false
                              true)
                            :boolean 
                            state)
                 [:gtm :tapes active :position]
                 inc)))
      state)))

(define-registered ;; make tape 0 blank at current position
  gtm_erase
  ^{:stack-types [:gtm]}
  (fn [state]
    (if (and (:gtm state)
             (not (zero? (:active (:gtm state)))))
      (let [write-tape (get (:tapes (:gtm state)) 0)
            write-position (:position write-tape)]
        (trace 'gtm_erase
               (-> state
                   (assoc-in [:gtm :tapes 0 :contents]
                             (dissoc (:contents write-tape) write-position))
                   (update-in [:gtm :tapes 0 :position] inc))))
      state)))

(define-registered ;; push active tape's instruction to code stack
  gtm_instruction
  ^{:stack-types [:gtm :code]}
  (fn [state]
    (if (:gtm state)
      (let [active (:active (:gtm state))
            active-tape (get (:tapes (:gtm state)) active)
            instr-map (get (:contents active-tape) (:position active-tape))]
        (if instr-map
          (trace 'gtm_instruction
                 (update-in
                   (push-item (:instruction instr-map) :code state)
                   [:gtm :tapes active :position]
                   inc))
          state))
      state)))

(define-registered ;; set instruction to first of flattened top of code stack
  gtm_set_instruction
  ^{:stack-types [:gtm :code]}
  (fn [state]
    (if (and (:gtm state)
             (not (empty? (:code state)))
             (not (empty? (ensure-list (stack-ref :code 0 state)))))
      (let [write-tape (get (:tapes (:gtm state)) 0)
            write-position (:position write-tape)
            write-contents (:contents write-tape)
            write-instr-map (ensure-instruction-map 
                              (get write-contents write-position))
            new-instr (first (flatten (ensure-list (stack-ref :code 0 state))))]
        (trace 'gtm_set_instruction
               (-> (pop-item :code state)
                   (assoc-in [:gtm :tapes 0 :contents write-position]
                             (assoc write-instr-map :instruction new-instr))
                   (update-in [:gtm :tapes 0 :position] inc))))
      state)))

(define-registered ;; push active tape's silent marker to boolean stack
  gtm_silent
  ^{:stack-types [:gtm :boolean]}
  (fn [state]
    (if (:gtm state)
      (let [active (:active (:gtm state))
            active-tape (get (:tapes (:gtm state)) active)
            instr-map (get (:contents active-tape) (:position active-tape))]
        (if instr-map
          (trace 'gtm_silent
                 (update-in
                   (push-item (:silent instr-map) :boolean state)
                   [:gtm :tapes active :position]
                   inc))
          state))
      state)))

(define-registered ;; set silent to top of boolean stack
  gtm_set_silent
  ^{:stack-types [:gtm :boolean]}
  (fn [state]
    (if (and (:gtm state)
             (not (empty? (:boolean state))))
      (let [write-tape (get (:tapes (:gtm state)) 0)
            write-position (:position write-tape)
            write-contents (:contents write-tape)
            write-instr-map (ensure-instruction-map 
                              (get write-contents write-position))
            new-silent (stack-ref :boolean 0 state)]
        (trace 'gtm_set_silent
               (-> (pop-item :boolean state)
                   (assoc-in [:gtm :tapes 0 :contents write-position]
                             (assoc write-instr-map :silent new-silent))
                   (update-in [:gtm :tapes 0 :position] inc))))
      state)))

(define-registered ;; push active tape's close marker to integer stack
  gtm_close
  ^{:stack-types [:gtm :integer]}
  (fn [state]
    (if (:gtm state)
      (let [active (:active (:gtm state))
            active-tape (get (:tapes (:gtm state)) active)
            instr-map (get (:contents active-tape) (:position active-tape))]
        (if instr-map
          (trace 'gtm_close
                 (update-in
                   (push-item (:close instr-map) :integer state)
                   [:gtm :tapes active :position]
                   inc))
          state))
      state)))

(define-registered ;; set close to abs value of top of integer stack
  gtm_set_close
  ^{:stack-types [:gtm :integer]}
  (fn [state]
    (if (and (:gtm state)
             (not (empty? (:integer state))))
      (let [write-tape (get (:tapes (:gtm state)) 0)
            write-position (:position write-tape)
            write-contents (:contents write-tape)
            write-instr-map (ensure-instruction-map 
                              (get write-contents write-position))
            new-close (math/abs (stack-ref :integer 0 state))]
        (trace 'gtm_set_close
               (-> (pop-item :integer state)
                   (assoc-in [:gtm :tapes 0 :contents write-position]
                             (assoc write-instr-map :close new-close))
                   (update-in [:gtm :tapes 0 :position] inc))))
      state)))

;; some tests

  (:use [clojush pushstate globals random util])
  (:require [clojure.math.numeric-tower :as math]))

;; Only read/write to one tape.

;; Single head position.

;; Secondary tape accessed only via gene/component swaps at current location.

;; Read/write by component or all components together.

;; Read (but not swap) no-ops over blanks, write creates an instruction-map 
;; (gene) under the head if none existed previously, with default instruction
;; exec_noop, silent false, and close 0.

;; All GTM instructions are no-ops on Push states that lack a GTM. 


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; gtm (genetic turing machine) utilities

(defn init-gtm
  "Returns the provided Push state, but with a fresh GTM that has been initialized."
  [push-state]
  (assoc push-state 
    :gtm
    {:position 0
     :tapes (vec (repeat 2 (sorted-map)))
     :trace []
     :offset 0}))

(defn ensure-instruction-map
  "If instr-map is a hash map, returns it unchanged; otherwise returns a default 
