open BitVectors;;

type ('a,'b) union2 = [ `U1 of 'a | `U2 of 'b ]
type ('a,'b,'c) union3 = [ `U1 of 'a | `U2 of 'b | `U3 of 'c ]
type ('a,'b,'c,'d,'e,'f) union6 = [ `U1 of 'a | `U2 of 'b | `U3 of 'c | `U4 of 'd | `U5 of 'e | `U6 of 'f ]

type direct = [ `DIRECT of byte ]
type indirect = [ `INDIRECT of bit ]
type ext_indirect = [ `EXT_INDIRECT of bit ]
type reg = [ `REG of bit * bit * bit ]
type acc = [ `A ]
type b = [ `B ]
type dptr = [ `DPTR ]
type data = [ `DATA of byte ]
type data16 = [ `DATA16 of word ]
type acc_dptr = [ `A_DPTR ]
type acc_pc = [ `A_PC ]
type ext_indirect_dptr = [ `EXT_IND_DPTR ]
type indirect_dptr = [ `IND_DPTR ]
type carry = [ `C ]
type bit = [ `BIT of byte ]
type nbit = [ `NBIT of byte ]
type rel = [ `REL of byte ]
type addr11 = [ `ADDR11 of word11 ]
type addr16 = [ `ADDR16 of word ]

type 'addr jump =
 [ `JC of 'addr
 | `JNC of 'addr
 | `JB of bit * 'addr
 | `JNB of bit * 'addr
 | `JBC of bit * 'addr
 | `JZ of 'addr
 | `JNZ of 'addr
 | `CJNE of (acc * [ direct | data ], [ reg | indirect ] * data) union2 * 'addr
 | `DJNZ of [ reg | direct ] * 'addr
 ]

type 'addr preinstruction =
 (* arithmetic operations *)
 [ `ADD of acc * [ reg | direct | indirect | data ]
 | `ADDC of acc * [ reg | direct | indirect | data ]
 | `SUBB of acc * [ reg | direct | indirect | data ]
 | `INC of [ acc | reg | direct | indirect | dptr ]
 | `DEC of [ acc | reg | direct | indirect ]
 | `MUL of acc * b
 | `DIV of acc * b
 | `DA  of acc

 (* logical operations *)
 | `ANL of
    (acc * [ reg | direct | indirect | data ],
     direct * [ acc | data ],
     carry * [ bit | nbit]) union3
 | `ORL of
    (acc * [ reg | data | direct | indirect ],
     direct * [ acc | data ],
     carry * [ bit | nbit]) union3
 | `XRL of
    (acc * [ data | reg | direct | indirect ],
     direct * [ acc | data ]) union2
 | `CLR of [ acc | carry | bit ]
 | `CPL of [ acc | carry | bit ]
 | `RL of acc
 | `RLC of acc
 | `RR of acc
 | `RRC of acc
 | `SWAP of acc

 (* data transfer *)
 | `MOV of 
    (acc * [ reg | direct | indirect | data ],
     [ reg | indirect ] * [ acc | direct | data ],
     direct * [ acc | reg | direct | indirect | data ],
     dptr * data16,
     carry * bit,
     bit * carry
     ) union6
 | `MOVC of acc * [ acc_dptr | acc_pc ]
 | `MOVX of (acc * [ ext_indirect | ext_indirect_dptr ],
            [ ext_indirect | ext_indirect_dptr ] * acc) union2
 | `SETB of [ carry | bit ]
 | `PUSH of direct
 | `POP of direct
 | `XCH of acc * [ reg | direct | indirect ]
 | `XCHD of acc * indirect

 (* program branching *)
 | 'addr jump 
 | `ACALL of addr11
 | `LCALL of addr16
 | `RET
 | `RETI
 | `AJMP of addr11
 | `LJMP of addr16
 | `SJMP of rel
 | `JMP of indirect_dptr
 | `NOP ]

type instruction = rel preinstruction

type labelled_instruction =
 [ instruction
 | `Cost of string
 | `Label of string
 | `Jmp of string
 | `Call of string
 | `Mov of dptr * string
 | `WithLabel of [`Label of string] jump
 ]

(* pairs <datalabel,size> *)
type preamble = (string * int) list

(* has_main currently unused *)
type 'a pretty_program =
    { ppreamble   : preamble ;
      pexit_label : string ;
      pcode       : 'a list ;
      phas_main   : bool }

type program =
    { code        : BitVectors.byte list ;
      cost_labels : string BitVectors.WordMap.t ;
      labels      : BitVectors.word StringTools.Map.t ;
      exit_addr   : BitVectors.word ;
      has_main    : bool }