reynir/asm-parser adapter to DcpuAsm

DcpuAsmAdapter.ml

module A = Ast
module W = Weedingast
module D = DcpuAsm
module DExpr = D.AsmExpr__
module DStmt = D.Asm__

let convert_reg {A.reg=reg} =
    match reg with
    | A.A -> D.A
    | A.B -> D.B
    | A.C -> D.C
    | A.X -> D.X
    | A.Y -> D.Y
    | A.Z -> D.Z
    | A.I -> D.I
    | A.J -> D.J
    | A.PC -> D.PC
    | A.SP -> D.SP
    | A.O -> D.O

let convert_unop = function
    | A.O_Uminus -> DExpr.neg

let convert_binop = function
    | A.O_Plus -> DExpr.add
    | A.O_Minus -> DExpr.sub
    | A.O_Times -> DExpr.mul
    | A.O_Divide -> DExpr.div
    | A.O_Modulo -> DExpr.mod_
    | A.O_And -> DExpr.and_
    | A.O_Or -> DExpr.or_
    | A.O_Xor -> DExpr.xor

let rec convert_expr {W.expr=expr} =
    match expr with
    | W.IntConst v -> DExpr.imm (Int32.to_int v)
    | W.CharConst c -> DExpr.imm (int_of_char c)
    | W.LabelRef l -> DExpr.label l
    | W.Binop (e1,op,e2) -> convert_binop op (convert_expr e1)
                                             (convert_expr e2)
    | W.Unop (op,e) -> convert_unop op (convert_expr e)

let convert_value {W.value=value} =
    match value with
    | W.Reg r -> DExpr.reg (convert_reg r)
    | W.MemReg r -> DExpr.mem (DExpr.reg (convert_reg r))
    | W.MemRegLit (r,e) -> DExpr.mem (DExpr.add (DExpr.reg (convert_reg r))
                                                (convert_expr e))
    | W.Pop -> DExpr.pop
    | W.Peek -> DExpr.peek
    | W.Push -> DExpr.push
    | W.MemLit e -> DExpr.mem (convert_expr e)
    | W.Lit e -> convert_expr e

let convert_instr {W.instr=instr} =
    match instr with
    | W.Dat e -> DStmt.dat [convert_expr e]
    | W.DatStr s -> DStmt.dat [DExpr.str s]
    | W.Set (a,b) -> DStmt.set (convert_value a) (convert_value b)
    | W.Add (a,b) -> DStmt.add (convert_value a) (convert_value b)
    | W.Sub (a,b) -> DStmt.sub (convert_value a) (convert_value b)
    | W.Mul (a,b) -> DStmt.mul (convert_value a) (convert_value b)
    | W.Div (a,b) -> DStmt.div (convert_value a) (convert_value b)
    | W.Mod (a,b) -> DStmt.mod_ (convert_value a) (convert_value b)
    | W.Shl (a,b) -> DStmt.shl (convert_value a) (convert_value b)
    | W.Shr (a,b) -> DStmt.shr (convert_value a) (convert_value b)
    | W.And (a,b) -> DStmt.and_ (convert_value a) (convert_value b)
    | W.Bor (a,b) -> DStmt.bor (convert_value a) (convert_value b)
    | W.Xor (a,b) -> DStmt.xor (convert_value a) (convert_value b)
    | W.Ife (a,b) -> DStmt.ife (convert_value a) (convert_value b)
    | W.Ifn (a,b) -> DStmt.ifn (convert_value a) (convert_value b)
    | W.Ifg (a,b) -> DStmt.ifg (convert_value a) (convert_value b)
    | W.Ifb (a,b) -> DStmt.ifb (convert_value a) (convert_value b)
    | W.Jsr a -> DStmt.jsr (convert_value a)

let rec convert_stmt {W.stmt=stmt} =
    match stmt with
    | W.Nothing -> D.Nothing
    | W.Instruction i -> convert_instr i
    | W.Labeled (l,s) -> D.Labeled (l, convert_stmt s)
    | W.Blocked ss -> D.Blocked (List.map convert_stmt ss)

let convert_source {W.source_file_decl=decl} =
    List.map convert_stmt decl

let compile wast =
    let dast = convert_source wast in
    let dast' = D.asm dast in
    D.to_binary_le dast'

main.ml

let parse () =
  try
    let lexbuf = Lexing.from_channel stdin in
    let lcp = lexbuf.Lexing.lex_curr_p in
    let () = lexbuf.Lexing.lex_curr_p <- { lcp with Lexing.pos_fname = "stdin" } in
      try
        let sf = Parser.goal Lexer.token lexbuf in
          sf
      with
        | End_of_file ->
              failwith "Parse error: end of file"
        | Parsing.Parse_error ->
            let curr_pos = lexbuf.Lexing.lex_curr_p in
              Error.print_position curr_pos;
              failwith "Parse error"
        | Failure msg ->
            let curr_pos = lexbuf.Lexing.lex_curr_p in
              Error.print_position curr_pos;
              failwith msg
  with
    | End_of_file ->
        failwith "Parse error: end of file from lexer"

let _ =
  let ast = parse () in
  let wast = Weeding.weed_source_file ast in
    (* Weedingastpp.pp_source_file wast *)
  let binary = DcpuAsmAdapter.compile wast in
  print_string binary