structure Linker =
struct
  fun makeOpcode w code arg1Const arg2Const =
    if code >= 0x40
    then raise Fail "code is more than 6 bits"
    else
      let
        val arg1Bit = if arg1Const then 2 else 0
        val arg2Bit = if arg2Const then 1 else 0
      in
        BinIO.output1 (w, Word8.fromInt (code * 4 + arg1Bit + arg2Bit))
      end

  fun isConst (Syntax.VVar _) = false
    | isConst _ = true

  fun lowByte w n =
    BinIO.output1 (w, Word8.fromInt (Word.toInt (Word.andb (n, Word.fromInt 0xff))))

  fun writeInt w i =
    let val n = Word.fromInt i
    in
      (lowByte w (Word.orb (Word.<< (n, Word.fromInt 1), Word.fromInt 0x1)) ;
       lowByte w (Word.>> (n, Word.fromInt 7)) ;
       lowByte w (Word.>> (n, Word.fromInt 15)) ;
       lowByte w (Word.>> (n, Word.fromInt 23)) ;
       lowByte w (Word.>> (n, Word.fromInt 31)) ;
       lowByte w (Word.>> (n, Word.fromInt 39)) ;
       lowByte w (Word.>> (n, Word.fromInt 47)) ;
       lowByte w (Word.>> (n, Word.fromInt 55)))
    end

  fun writeVar w v =
    if v > CodeGen.tempReg
    then raise Fail ("var out of range: " ^ Int.toString v)
    else lowByte w (Word.fromInt v)

  fun writeOffset w i =
    if 0 > i orelse i > 127
    then raise Fail ("offset out of range: " ^ Int.toString i)
    else lowByte w (Word.fromInt i)

  structure IntMap = Map(type k = int val cmp = Int.compare);

  fun encode (m : int IntMap.map) (w : BinIO.outstream) (oper : Syntax.opcode) : unit =
    let
      fun writeValue w (Syntax.VVar v) = writeVar w v
        | writeValue w (Syntax.VLabel l) = writeInt w (getOpt (IntMap.lookup l m, 0))
        | writeValue w (Syntax.VInt i) = writeInt w i
        | writeValue w (Syntax.VString _) = raise Fail "I don't support strings yet"
    in
      case oper of
        Syntax.OAlloc (r, v) =>
          (makeOpcode w 1 (isConst v) false ;
           writeVar w r ;
           writeValue w v)
      | Syntax.OCall =>
          makeOpcode w 2 false false
      | Syntax.OPoke (off, p, v) =>
          (makeOpcode w 3 (isConst v) false ;
           writeOffset w off ;
           writeVar w p ;
           writeValue w v)
      | Syntax.OPeek (r, off, v) =>
          (makeOpcode w 4 (isConst v) false ;
           writeVar w r ;
           writeOffset w off ;
           writeValue w v)
      | Syntax.OShuf (r, v) =>
          (makeOpcode w 5 (isConst v) false ;
           writeVar w r ;
           writeValue w v)
      | Syntax.OExit v =>
          (makeOpcode w 6 (isConst v) false ;
           writeValue w v)
      | Syntax.OLabel _ => ()
    end

  fun link (program : Syntax.opcode list) : Word8Vector.vector =
    let
      val (w1, b1) = Buffer.buf ()
      val labels =
        foldl
          (fn (x, acc) =>
            (encode IntMap.empty w1 x ;
             case x of
               Syntax.OLabel l => IntMap.insert l (Word8ArraySlice.length (!b1)) acc
             | _ => acc))
          IntMap.empty
          program
      val (w, b) = Buffer.buf ()
      fun go [] = ()
        | go (oper :: program) =
            (encode labels w oper ;
             go program)
    in
      go program ;
      Word8ArraySlice.vector (!b)
    end
end