From dae97b7a76d3e4a1b8a1f6b145f53456605eef57 Mon Sep 17 00:00:00 2001 From: Konarak Date: Wed, 3 Aug 2022 18:34:42 +0530 Subject: [PATCH] [WIP] initial compiler backend code --- compiler/.gitignore | 1 + compiler/.ocamlformat | 2 + compiler/README.md | 1 + compiler/bin/compiler.ml | 31 ++++++++++++++ compiler/bin/dune | 3 ++ compiler/dune-project | 2 + compiler/lib/be_ast.ml | 4 ++ compiler/lib/be_lexer.mll | 57 ++++++++++++++++++++++++ compiler/lib/be_parser.mly | 24 +++++++++++ compiler/lib/be_predef.ml | 81 +++++++++++++++++++++++++++++++++++ compiler/lib/be_translate.ml | 24 +++++++++++ compiler/lib/dune | 9 ++++ compiler/test/dune | 3 ++ compiler/test/test_backend.ml | 31 ++++++++++++++ 14 files changed, 273 insertions(+) create mode 100644 compiler/.gitignore create mode 100644 compiler/.ocamlformat create mode 100644 compiler/README.md create mode 100644 compiler/bin/compiler.ml create mode 100644 compiler/bin/dune create mode 100644 compiler/dune-project create mode 100644 compiler/lib/be_ast.ml create mode 100644 compiler/lib/be_lexer.mll create mode 100644 compiler/lib/be_parser.mly create mode 100644 compiler/lib/be_predef.ml create mode 100644 compiler/lib/be_translate.ml create mode 100644 compiler/lib/dune create mode 100644 compiler/test/dune create mode 100644 compiler/test/test_backend.ml diff --git a/compiler/.gitignore b/compiler/.gitignore new file mode 100644 index 0000000..e35d885 --- /dev/null +++ b/compiler/.gitignore @@ -0,0 +1 @@ +_build diff --git a/compiler/.ocamlformat b/compiler/.ocamlformat new file mode 100644 index 0000000..8d15ff8 --- /dev/null +++ b/compiler/.ocamlformat @@ -0,0 +1,2 @@ +profile = janestreet +version = 0.24.1 diff --git a/compiler/README.md b/compiler/README.md new file mode 100644 index 0000000..8b13789 --- /dev/null +++ b/compiler/README.md @@ -0,0 +1 @@ + diff --git a/compiler/bin/compiler.ml b/compiler/bin/compiler.ml new file mode 100644 index 0000000..3db3802 --- /dev/null +++ b/compiler/bin/compiler.ml @@ -0,0 +1,31 @@ +open Core +open Backend + +let read_file file = + let not_empty str = not (String.is_empty str) in + List.filter (In_channel.read_lines file) ~f:not_empty +;; + +let outfile file = String.concat [ Filename.chop_extension file; ".asm" ] + +let gen_hack file = + let ircode = read_file file in + let assembly = Be_translate.translate ircode in + let outchan = Out_channel.create (outfile file) in + Out_channel.output_lines outchan assembly; + Out_channel.close outchan +;; + +let param = + let open Command.Param in + anon ("filename" %: string) +;; + +let command = + Command.basic + ~summary:"Translate .vm to .asm" + ~readme:(fun () -> "Compiler (backend) for project 7 of Nand2Tetris") + (Command.Param.map param ~f:(fun filename () -> gen_hack filename)) +;; + +let () = Command_unix.run command diff --git a/compiler/bin/dune b/compiler/bin/dune new file mode 100644 index 0000000..ddd0e3f --- /dev/null +++ b/compiler/bin/dune @@ -0,0 +1,3 @@ +(executable + (name compiler) + (libraries backend core core_unix.command_unix)) diff --git a/compiler/dune-project b/compiler/dune-project new file mode 100644 index 0000000..8054eb6 --- /dev/null +++ b/compiler/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.3) +(using menhir 2.0) diff --git a/compiler/lib/be_ast.ml b/compiler/lib/be_ast.ml new file mode 100644 index 0000000..94e21dc --- /dev/null +++ b/compiler/lib/be_ast.ml @@ -0,0 +1,4 @@ +type expr = + | Comment of string + | Acommand of string + | Mcommand of string * string * string diff --git a/compiler/lib/be_lexer.mll b/compiler/lib/be_lexer.mll new file mode 100644 index 0000000..1e83d31 --- /dev/null +++ b/compiler/lib/be_lexer.mll @@ -0,0 +1,57 @@ +{ +open Be_parser +} + +let address = ['0'-'9']+ + +(* let ADD = "add" +let SUB = "sub" +let NEG = "neg" +let EQ = "eq" +let GT = "gt" +let LT = "lt" +let AND = "and" +let OR = "or" +let NOT = "not" +let POP = "pop" +let PUSH = "push" *) + +let command = "add" + | "sub" + | "neg" + | "eq" + | "gt" + | "lt" + | "and" + | "or" + | "not" + | "pop" + | "push" + +let segment = "argument" + | "local" + | "static" + | "this" + | "that" + | "pointer" + | "temp" + | "constant" + +let white = [' ' '\t']+ +let comment = "//" _* + +(* +let digit = ['0'-'9'] +let letter = ['a'-'z' 'A'-'Z'] +let special = ['.' '$' '_' '-' '+' '&' '!' '|'] +let id = (digit | letter | special)+ +*) + +rule read = + parse + | white { read lexbuf } + | address as a { ADDRESS (a) } + | command as c { COMMAND (c) } + | segment as s { SEGMENT (s) } + | comment as c { COMMENT (c) } + | eof { EOF } diff --git a/compiler/lib/be_parser.mly b/compiler/lib/be_parser.mly new file mode 100644 index 0000000..3ed9b41 --- /dev/null +++ b/compiler/lib/be_parser.mly @@ -0,0 +1,24 @@ +%{ +open Be_ast +%} + +%token ADDRESS +%token COMMAND +%token SEGMENT +%token COMMENT +%token EOF + +%start prog + +%% + +prog: + | e = expr; EOF { e } + ; + +expr: + | c = COMMENT { Comment c } + | c = COMMAND; { Acommand c } + | c = COMMAND; s = SEGMENT; a = ADDRESS { Mcommand (c, s, a) } + | e = expr; COMMENT { e } + ; diff --git a/compiler/lib/be_predef.ml b/compiler/lib/be_predef.ml new file mode 100644 index 0000000..397cd6d --- /dev/null +++ b/compiler/lib/be_predef.ml @@ -0,0 +1,81 @@ +open Base + +let _unary = [ "@SP"; "A=M-1" ] +let _binary = [ "@SP"; "AM=M-1"; "D=M"; "A=A-1" ] +let _add = _binary @ [ "M=M+D" ] +let _sub = _binary @ [ "M=M-D" ] +let _neg = _unary @ [ "M=-M" ] +let _and = _binary @ [ "M=D&M" ] +let _or = _binary @ [ "M=D|M" ] +let _not = _unary @ [ "M=!M" ] + +let _eq loc = + _binary + @ [ "D=M-D" + ; "M=-1" + ; "@END_EQ_" ^ loc + ; "D;JEQ" + ; "@SP" + ; "A=M-1" + ; "M=0" + ; "(END_EQ_" ^ loc ^ ")" + ] +;; + +let _gt loc = + _binary + @ [ "D=M-D" + ; "M=-1" + ; "@END_GT_" ^ loc + ; "D;JGT" + ; "@SP" + ; "A=M-1" + ; "M=0" + ; "(END_GT_" ^ loc ^ ")" + ] +;; + +let _lt loc = + _binary + @ [ "D=M-D" + ; "M=-1" + ; "@END_LT_" ^ loc + ; "D;JLT" + ; "@SP" + ; "A=M-1" + ; "M=0" + ; "(END_LT_" ^ loc ^ ")" + ] +;; + +let a_command ?(loc = 0) a = + let suffix = Int.to_string loc in + match a with + | "add" -> _add + | "sub" -> _sub + | "neg" -> _neg + | "eq" -> _eq suffix + | "gt" -> _gt suffix + | "lt" -> _lt suffix + | "and" -> _and + | "or" -> _or + | "not" -> _not + | _ -> failwith "a_command: Invalid Command" +;; + +let addr a = [ String.concat [ "@"; a ] ] +let push_constant = [ "D=A"; "@SP"; "A=M"; "M=D"; "@SP"; "M=M+1" ] + +let _end = ["(TERMINATE)"; "@TERMINATE"; "0;JMP"] + +let _process_push s a = + match s with + | "constant" -> addr a @ push_constant + | _ -> failwith "Invalid Segment" +;; + +let m_command (c, s, a) = + match c with + | "push" -> _process_push s a + | _ -> failwith "m_command: Invalid Command" +;; diff --git a/compiler/lib/be_translate.ml b/compiler/lib/be_translate.ml new file mode 100644 index 0000000..e69e01a --- /dev/null +++ b/compiler/lib/be_translate.ml @@ -0,0 +1,24 @@ +open Base +open Be_ast +open Be_predef + +let parse s = + let lexbuf = Lexing.from_string s in + let ast = Be_parser.prog Be_lexer.read lexbuf in + ast +;; + +let generate_exprs lines = List.map lines ~f:parse + +let rec _translate expr loc tt = + match expr with + | [] -> tt + | Acommand a :: t -> a_command ?loc:(Some loc) a @ _translate t (loc+1) tt + | Mcommand (c, s, a) :: t -> m_command (c, s, a) @ _translate t loc tt + | _ :: t -> _translate t loc tt +;; + +let translate lines = + let exprs = generate_exprs lines in + _translate exprs 0 [] @ _end +;; diff --git a/compiler/lib/dune b/compiler/lib/dune new file mode 100644 index 0000000..2f40d16 --- /dev/null +++ b/compiler/lib/dune @@ -0,0 +1,9 @@ +(ocamllex be_lexer) + +(menhir + (modules be_parser)) + +(library + (name backend) + (modules be_ast be_predef be_translate be_lexer be_parser) + (libraries base)) diff --git a/compiler/test/dune b/compiler/test/dune new file mode 100644 index 0000000..2563b0a --- /dev/null +++ b/compiler/test/dune @@ -0,0 +1,3 @@ +(tests + (names test_backend) + (libraries backend ounit2)) diff --git a/compiler/test/test_backend.ml b/compiler/test/test_backend.ml new file mode 100644 index 0000000..5001b92 --- /dev/null +++ b/compiler/test/test_backend.ml @@ -0,0 +1,31 @@ +open OUnit2 +open Backend.Be_ast +open Backend.Be_translate + +let peq case value = assert_equal value (parse case) + +let test_parse_a_command _ = + peq "add" (Acommand "add"); + peq "sub" (Acommand "sub"); + peq "neg" (Acommand "neg"); + peq "eq" (Acommand "eq"); + peq "gt" (Acommand "gt"); + peq "lt" (Acommand "lt"); + peq "and" (Acommand "and"); + peq "or" (Acommand "or"); + peq "not" (Acommand "not") +;; + +let test_parse_m_command _ = + peq "pop local 12" (Mcommand ("pop", "local", "12")); + peq "push argument 4" (Mcommand ("push", "argument", "4")) +;; + +let suite = + "suite" + >::: [ "A Instruction" >:: test_parse_a_command + ; "M Instruction" >:: test_parse_m_command + ] +;; + +let () = run_test_tt_main suite