(local 
	{: r
	: move
	: branch
	: branch-link
  : relocatable-instructions}
	(require :host.assembler.opcodes))
(local {: any : slice : push : map :match find-pred} (require :deps.lume))
(local {: word->byte : hex} (require :host.util))

(fn label [name] {:label name})
(fn label? [value]
	(if (and (= (type value) :table) (. value :label)) true false))

(fn insert-label [table label index]
	(if (. table :label)
			(:error (.. "Duplicate label " label))
			(tset table :labels label index)))

(fn replace-label!
  [form offset]
  "Replace the label form with *offset* for later linking"
  (each [i v (ipairs form)] (when (label? v) (tset form i offset)))
  form)

(fn assemble [forms offset]
	(let [state {:labels {} :instructions [] :reverse-labels []}]
		(each [_ form (ipairs forms)]
			(if (= (type form) :string)
					(insert-label state form (+ offset (* 4 (length (. state :instructions)))))
					(push (. state :instructions)
								(if (any (slice form 2) label?)
										(let [{: type :offset addend} (. relocatable-instructions (. form 1))]
											(push (. state :reverse-labels) {: type :label (. (find-pred form label?) :label) :offset (+ offset (* 4 (length (. state :instructions))))})
                      ((. form 1) (table.unpack (replace-label! (slice form 2) addend))))
										((. form 1) (table.unpack (slice form 2)))))))
		state))

(fn link [{: labels : instructions : reverse-labels} base]
	(each [_ {: type :label target : offset} (ipairs reverse-labels)]
    (match type
      :jump-24 (let [index (+ 1 (/ (- offset base) 4))
                     instruction (. instructions index)
                     addend (lshift (band instruction 0xffffff) 2)
                     symbol (. labels target)
                     relocation (- (+ symbol addend) offset)
                     new-instruction 
                     (bor
                       (band instruction (bnot 0xffffff))
                       (band (rshift relocation 2) 0xffffff))]
                 (print (hex (band (rshift relocation 2) 0xffffff)) (hex instruction) (hex new-instruction))
                 (tset instructions index new-instruction))))
  instructions)

(map (link (assemble
        [[move (r 8) (r 2)]
         :label-1
         [move (r 9) (r 3)]
         [branch (label :label-1)]]
        0x8000)
      0x8000) hex)