diff --git a/compiler/.gitignore b/compiler/backend/.gitignore similarity index 100% rename from compiler/.gitignore rename to compiler/backend/.gitignore diff --git a/compiler/.ocamlformat b/compiler/backend/.ocamlformat similarity index 55% rename from compiler/.ocamlformat rename to compiler/backend/.ocamlformat index 8d15ff8..f944029 100644 --- a/compiler/.ocamlformat +++ b/compiler/backend/.ocamlformat @@ -1,2 +1,2 @@ profile = janestreet -version = 0.24.1 +version = 0.26.2 diff --git a/compiler/README.md b/compiler/backend/README.md similarity index 100% rename from compiler/README.md rename to compiler/backend/README.md diff --git a/compiler/backend/bin/compiler.ml b/compiler/backend/bin/compiler.ml new file mode 100644 index 0000000..48ae9be --- /dev/null +++ b/compiler/backend/bin/compiler.ml @@ -0,0 +1,61 @@ +open Core +open Backend + +let read_file file = + let lines = In_channel.read_lines file in + let not_empty str = not (String.is_empty str) in + List.filter lines ~f:not_empty + + +let is_vm_file f = + match Filename.split_extension f with + | _, Some ext -> String.equal ext "vm" + | _, None -> false + + +let generate_hack f = + let bytecode = read_file f in + let class_name = Filename.basename f in + Translate.translate class_name bytecode + + +let write_hack path hack = + let output_channel = Out_channel.create path in + Out_channel.output_lines output_channel hack; + Out_channel.close output_channel + + +let compile path = + let ext = ".asm" in + let absolute_path x = path ^ x in + let open Filename_base in + if Sys_unix.is_directory_exn path then + let output_file = concat path (basename path ^ ext) in + let hack = + path + |> Sys_unix.ls_dir + |> List.map ~f:absolute_path + |> List.filter ~f:is_vm_file + |> List.concat_map ~f:generate_hack + |> List.append Translate.bootstrap + in + write_hack output_file hack + else if Sys_unix.is_file_exn path && is_vm_file path then + let output_file = chop_extension path ^ ext in + let hack = generate_hack path in + write_hack output_file hack + else + failwith "Incompatible!" + + +let command = + let summary = "Translate Jack byte code to Hack assembly" in + let readme () = "Compiler (backend) for project 7/8 of Nand2Tetris" in + let param_spec = Command.Param.(anon ("path" %: string)) in + let param_handler path () = compile path in + Command.basic + ~summary:summary ~readme:readme + (Command.Param.map param_spec ~f:param_handler) + + +let () = Command_unix.run command diff --git a/compiler/backend/bin/compiler.mli b/compiler/backend/bin/compiler.mli new file mode 100644 index 0000000..a2e1ab6 --- /dev/null +++ b/compiler/backend/bin/compiler.mli @@ -0,0 +1 @@ +val command : Command.t diff --git a/compiler/bin/dune b/compiler/backend/bin/dune similarity index 65% rename from compiler/bin/dune rename to compiler/backend/bin/dune index ddd0e3f..92d8ee0 100644 --- a/compiler/bin/dune +++ b/compiler/backend/bin/dune @@ -1,3 +1,5 @@ (executable + (modes byte exe) (name compiler) + (public_name compiler) (libraries backend core core_unix.command_unix)) diff --git a/compiler/backend/compiler.opam b/compiler/backend/compiler.opam new file mode 100644 index 0000000..e69de29 diff --git a/compiler/backend/dune-project b/compiler/backend/dune-project new file mode 100644 index 0000000..a35daa8 --- /dev/null +++ b/compiler/backend/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.13) +(using menhir 3.0) diff --git a/compiler/backend/lib/arithmetic.ml b/compiler/backend/lib/arithmetic.ml new file mode 100644 index 0000000..7e41fd8 --- /dev/null +++ b/compiler/backend/lib/arithmetic.ml @@ -0,0 +1,78 @@ +open! Ast +open! Base + +let counter = ref 0 + +let count = + fun () -> + counter := (!counter) + 1; + !counter + + +let arithmetic = + Map.of_alist_exn (module String) + [ "add", [ "@SP"; "AM=M-1"; "D=M"; "A=A-1"; "M=D+M" ] + ; "sub", [ "@SP"; "AM=M-1"; "D=M"; "A=A-1"; "M=M-D" ] + ; "and", [ "@SP"; "AM=M-1"; "D=M"; "A=A-1"; "M=D&M" ] + ; "or" , [ "@SP"; "AM=M-1"; "D=M"; "A=A-1"; "M=D|M" ] + ; "neg", [ "@SP"; "A=M-1"; "M=-M" ] + ; "not", [ "@SP"; "A=M-1"; "M=!M" ] + ] + +let eq count = + [ "@SP" + ; "AM=M-1" + ; "D=M" + ; "A=A-1" + ; "D=M-D" + ; "M=-1" + ; "@END_EQ_" ^ count + ; "D;JEQ" + ; "@SP" + ; "A=M-1" + ; "M=0" + ; "(END_EQ_" ^ count ^ ")" + ] + +let gt count = + [ "@SP" + ; "AM=M-1" + ; "D=M" + ; "A=A-1" + ; "D=M-D" + ; "M=-1" + ; "@END_GT_" ^ count + ; "D;JGT" + ; "@SP" + ; "A=M-1" + ; "M=0" + ; "(END_GT_" ^ count ^ ")" + ] + +let lt count = + [ "@SP" + ; "AM=M-1" + ; "D=M" + ; "A=A-1" + ; "D=M-D" + ; "M=-1" + ; "@END_LT_" ^ count + ; "D;JLT" + ; "@SP" + ; "A=M-1" + ; "M=0" + ; "(END_LT_" ^ count ^ ")" + ] + +let translate command = + let i = Int.to_string (count ()) in + match command with + | Add -> Map.find_exn arithmetic "add" + | Sub -> Map.find_exn arithmetic "sub" + | Neg -> Map.find_exn arithmetic "neg" + | And -> Map.find_exn arithmetic "and" + | Not -> Map.find_exn arithmetic "not" + | Or -> Map.find_exn arithmetic "or" + | Eq -> eq i + | Gt -> gt i + | Lt -> lt i diff --git a/compiler/backend/lib/arithmetic.mli b/compiler/backend/lib/arithmetic.mli new file mode 100644 index 0000000..11d18a5 --- /dev/null +++ b/compiler/backend/lib/arithmetic.mli @@ -0,0 +1 @@ +val translate : Ast.arithmetic_command -> string list diff --git a/compiler/backend/lib/ast.ml b/compiler/backend/lib/ast.ml new file mode 100644 index 0000000..b6b71ef --- /dev/null +++ b/compiler/backend/lib/ast.ml @@ -0,0 +1,41 @@ +type arithmetic_command = + | Add + | Sub + | Neg + | Eq + | Gt + | Lt + | And + | Or + | Not + +type memory_segment = + | Argument + | Local + | Static + | Constant + | This + | That + | Pointer + | Temp + +type memory_command = + | Push + | Pop + +type branching_command = + | Label + | Goto + | Ifgoto + +type function_command = + | Function + | Call + +type expr = + | Comment of string + | ArithmeticCommand of arithmetic_command + | MemoryAccessCommand of memory_command * memory_segment * int + | ProgramFlowCommand of branching_command * string + | FunctionCallCommand of function_command * string * int + | Return diff --git a/compiler/backend/lib/dune b/compiler/backend/lib/dune new file mode 100644 index 0000000..4930108 --- /dev/null +++ b/compiler/backend/lib/dune @@ -0,0 +1,8 @@ +(ocamllex lexer) + +(menhir + (modules parser)) + +(library + (name backend) + (libraries core)) diff --git a/compiler/backend/lib/functioncall.ml b/compiler/backend/lib/functioncall.ml new file mode 100644 index 0000000..fe2f386 --- /dev/null +++ b/compiler/backend/lib/functioncall.ml @@ -0,0 +1,95 @@ +open! Ast +open! Base + +let counter = ref 0 + +let count = + fun () -> + counter := (!counter) + 1; + !counter + +let addr a = "@" ^ a + +let label name = "(" ^ name ^ ")" + +let function_definition name arg = + let push_inner n = [ + addr n + ; "D=A" + ; "@LCL" + ; "A=D+M" + ; "M=0" + ; "@SP" + ; "M=M+1" + ] in + let locals = arg + |> List.init ~f:Int.to_string + |> List.concat_map ~f:push_inner in + List.append [ label name ] locals + +let function_call name arg = + let i = Int.to_string (count ()) in + let arg = Int.to_string arg in + let ret = name ^ "_RETURN_" ^ i in + [ addr ret + ; "D=A" + ; "@SP" + ; "A=M" + ; "M=D" + ; "@SP" + ; "M=M+1" + ; "// push LCL " + ; "@LCL" + ; "D=M" + ; "@SP" + ; "A=M" + ; "M=D" + ; "@SP" + ; "M=M+1" + ; "// push ARG " + ; "@ARG" + ; "D=M" + ; "@SP" + ; "A=M" + ; "M=D" + ; "@SP" + ; "M=M+1" + ; "// push THIS " + ; "@THIS" + ; "D=M" + ; "@SP" + ; "A=M" + ; "M=D" + ; "@SP" + ; "M=M+1" + ; "// push THAT " + ; "@THAT" + ; "D=M" + ; "@SP" + ; "A=M" + ; "M=D" + ; "@SP" + ; "M=M+1" + ; "// reposition ARG" + ; "D=M" + ; addr arg + ; "D=D-A" + ; "@5" + ; "D=D-A" + ; "@ARG" + ; "M=D" + ; "// reposition LCL" + ; "@SP" + ; "D=M" + ; "@LCL" + ; "M=D" + ; "// goto function" + ; addr name + ; "0;JMP" + ; label ret ] + +let translate command name arg = + match command with + | Function -> function_definition name arg + | Call -> function_call name arg + \ No newline at end of file diff --git a/compiler/backend/lib/functioncall.mli b/compiler/backend/lib/functioncall.mli new file mode 100644 index 0000000..e746d57 --- /dev/null +++ b/compiler/backend/lib/functioncall.mli @@ -0,0 +1 @@ +val translate : Ast.function_command -> string -> int -> string list diff --git a/compiler/backend/lib/lexer.mll b/compiler/backend/lib/lexer.mll new file mode 100644 index 0000000..728f6f6 --- /dev/null +++ b/compiler/backend/lib/lexer.mll @@ -0,0 +1,49 @@ +{ +open Parser +} + +let period = '.' +let colon = ':' +let underscore = '_' +let numbers = ['0'-'9']+ +let alphabets = ['a'-'z' 'A'-'Z']+ +let white = [' ' '\t']+ +let comment = "//" _* + + +let address = (numbers)+ +let id = (alphabets | numbers | colon | period | underscore)+ + +rule read = + parse + | white { read lexbuf } + | comment as c { COMMENT (c) } + | "add" { ADD } + | "sub" { SUB } + | "neg" { NEG } + | "eq" { EQ } + | "gt" { GT } + | "lt" { LT } + | "and" { AND } + | "or" { OR } + | "not" { NOT } + | "pop" { POP } + | "push" { PUSH } + | "argument" { ARGUMENT } + | "local" { LOCAL } + | "static" { STATIC } + | "this" { THIS } + | "that" { THAT } + | "pointer" { POINTER } + | "temp" { TEMP } + | "constant" { CONSTANT } + | "label" { LABEL } + | "goto" { GOTO } + | "if-goto" { IFGOTO } + | "function" { FUNCTION } + | "call" { CALL } + | "return" { RETURN } + | address as a { ADDRESS (int_of_string a) } + | id as i { ID (i) } + | eof { EOF } + | _ as c { failwith (Printf.sprintf "unexpected character: %C" c) } diff --git a/compiler/backend/lib/memoryaccess.ml b/compiler/backend/lib/memoryaccess.ml new file mode 100644 index 0000000..5945559 --- /dev/null +++ b/compiler/backend/lib/memoryaccess.ml @@ -0,0 +1,68 @@ +open! Ast +open! Base + +let addr a = "@" ^ a + +let push = [ "@SP"; "A=M"; "M=D"; "@SP"; "M=M+1" ] +let pop = [ "@R13"; "M=D"; "@SP"; "AM=M-1"; "D=M"; "@R13"; "A=M"; "M=D" ] + +let common = function + | Local -> "@LCL" + | This -> "@THIS" + | That -> "@THAT" + | Argument -> "@ARG" + | _ -> failwith "Invalid Segment" + +let pointer = function + | "0" -> "@THIS" + | "1" -> "@THAT" + | _ -> failwith "Invalid Pointer" + +let push_constant a = [ addr a; "D=A" ] @ push + +let push_pointer a = [ pointer a; "D=M" ] @ push + +let push_static offset class_name= + [ addr (class_name ^ ":" ^ offset); "D=M" ] @ push + +let push_temp a = [ addr a; "D=A"; "@5"; "A=D+A"; "D=M" ] @ push + +let pop_pointer a = + [ "@SP"; "AM=M-1"; "D=M"; pointer a; "M=D" ] + +let pop_static offset class_name = + [ "@SP"; "AM=M-1"; "D=M"; addr (class_name ^ ":" ^ offset); "M=D" ] + +let push_common segment offset = + [ addr offset ; "D=A" ; common segment ; "A=D+M" ; "D=M" ] @ push + +let pop_temp a = +[ addr a; "D=A"; "@5" ; "D=D+A" ] @ pop + +let pop_common segment offset = [ + addr offset + ; "D=A" + ; common segment + ; "D=D+M" ] @ pop + +let process_push segment offset class_name = + match segment with + | Local | Argument | This | That -> push_common segment offset + | Constant -> push_constant offset + | Temp -> push_temp offset + | Static -> push_static class_name offset + | Pointer -> push_pointer offset + +let process_pop segment offset class_name = + match segment with + | Local | Argument | This | That -> pop_common segment offset + | Temp -> pop_temp offset + | Static -> pop_static class_name offset + | Pointer -> pop_pointer offset + | Constant -> failwith "Invalid Segment" + +let translate command segment offset class_name = + let offset = Int.to_string offset in + match command with + | Pop -> process_pop segment offset class_name + | Push -> process_push segment offset class_name diff --git a/compiler/backend/lib/memoryaccess.mli b/compiler/backend/lib/memoryaccess.mli new file mode 100644 index 0000000..d7d14bc --- /dev/null +++ b/compiler/backend/lib/memoryaccess.mli @@ -0,0 +1,3 @@ +val translate : + Ast.memory_command -> + Ast.memory_segment -> int -> string -> string list diff --git a/compiler/backend/lib/parser.mly b/compiler/backend/lib/parser.mly new file mode 100644 index 0000000..9d861f1 --- /dev/null +++ b/compiler/backend/lib/parser.mly @@ -0,0 +1,93 @@ +%{ +open Ast +%} + + +(* arithmetic and logical commands *) +%token ADD SUB EQ GT LT AND OR NEG NOT + +(* memory commands *) +%token POP PUSH + +(* memory segments *) +%token CONSTANT STATIC POINTER TEMP + ARGUMENT LOCAL THIS THAT + +(* branching commands *) +%token LABEL GOTO IFGOTO + +(* function commands*) +%token FUNCTION CALL RETURN + +%token ADDRESS +%token ID +%token COMMENT +%token EOF + +%start prog + +%% + + +prog: + | e = expr; EOF { e } + ; + +expr: + | c = COMMENT { Comment c } + | e = arithmetic { e } + | POP; p = pop { p } + | PUSH; p = push { p } + | b = branching { b } + | FUNCTION; f = function_definition { f } + | CALL; c = function_call { c } + | RETURN { Return } + | e = expr; COMMENT { e } +; + +arithmetic: + | ADD { ArithmeticCommand Add } + | SUB { ArithmeticCommand Sub } + | EQ { ArithmeticCommand Eq } + | GT { ArithmeticCommand Gt } + | LT { ArithmeticCommand Lt } + | AND { ArithmeticCommand And } + | OR { ArithmeticCommand Or } + | NEG { ArithmeticCommand Neg } + | NOT { ArithmeticCommand Not } +; + +pop: + | ARGUMENT; a = ADDRESS { MemoryAccessCommand (Pop, Argument, a) } + | LOCAL; a = ADDRESS { MemoryAccessCommand (Pop, Local, a) } + | STATIC; a = ADDRESS { MemoryAccessCommand (Pop, Static, a) } + | THIS; a = ADDRESS { MemoryAccessCommand (Pop, This, a) } + | THAT; a = ADDRESS { MemoryAccessCommand (Pop, That, a) } + | POINTER; a = ADDRESS { MemoryAccessCommand (Pop, Pointer, a) } + | TEMP; a = ADDRESS { MemoryAccessCommand (Pop, Temp, a) } +; + +push: + | ARGUMENT; a = ADDRESS { MemoryAccessCommand (Push, Argument, a) } + | LOCAL; a = ADDRESS { MemoryAccessCommand (Push, Local, a) } + | STATIC; a = ADDRESS { MemoryAccessCommand (Push, Static, a) } + | THIS; a = ADDRESS { MemoryAccessCommand (Push, This, a) } + | THAT; a = ADDRESS { MemoryAccessCommand (Push, That, a) } + | POINTER; a = ADDRESS { MemoryAccessCommand (Push, Pointer, a) } + | TEMP; a = ADDRESS { MemoryAccessCommand (Push, Temp, a) } + | CONSTANT; a = ADDRESS { MemoryAccessCommand (Push, Constant, a) } +; + +branching: + | LABEL; i = ID { ProgramFlowCommand (Label, i) } + | GOTO; i = ID { ProgramFlowCommand (Goto, i) } + | IFGOTO; i = ID { ProgramFlowCommand (Ifgoto, i) } +; + +function_definition: + | i = ID; a = ADDRESS { FunctionCallCommand (Function, i, a) } +; + +function_call: + | i = ID; a = ADDRESS { FunctionCallCommand (Call, i, a) } +; \ No newline at end of file diff --git a/compiler/backend/lib/programflow.ml b/compiler/backend/lib/programflow.ml new file mode 100644 index 0000000..d81d5c3 --- /dev/null +++ b/compiler/backend/lib/programflow.ml @@ -0,0 +1,12 @@ +open! Ast +open! Base + +let addr a = "@" ^ a + +let label name = "(" ^ name ^ ")" + +let translate command name = + match command with + | Label -> [ label name ] + | Goto -> [ addr name; "0;JMP" ] + | Ifgoto -> [ "@SP"; "AM=M-1"; "D=M"; addr name; "D;JNE" ] diff --git a/compiler/backend/lib/programflow.mli b/compiler/backend/lib/programflow.mli new file mode 100644 index 0000000..bbbecae --- /dev/null +++ b/compiler/backend/lib/programflow.mli @@ -0,0 +1 @@ +val translate : Ast.branching_command -> string -> string list diff --git a/compiler/backend/lib/return.ml b/compiler/backend/lib/return.ml new file mode 100644 index 0000000..e20eb40 --- /dev/null +++ b/compiler/backend/lib/return.ml @@ -0,0 +1,47 @@ +let translate = + [ "// Save LCL to R14, Return Address to R15 " + ; "@LCL" + ; "D=M" + ; "@R14" + ; "M=D" + ; "@R5" + ; "A=D-A" + ; "D=M" + ; "@R15" + ; "M=D" + ; "// POP return value to ARG0, SP=ARG+1 " + ; "@SP" + ; "AM=M-1" + ; "D=M" + ; "@ARG" + ; "A=M" + ; "M=D" + ; "D=A" + ; "@SP" + ; "M=D+1" + ; "// reposition THAT, THIS, ARG, LCL " + ; "@R14" + ; "AM=M-1" + ; "D=M" + ; "@THAT" + ; "M=D" + ; "@R14" + ; "AM=M-1" + ; "D=M" + ; "@THIS" + ; "M=D" + ; "@R14" + ; "AM=M-1" + ; "D=M" + ; "@ARG" + ; "M=D" + ; "@R14" + ; "AM=M-1" + ; "D=M" + ; "@LCL" + ; "M=D" + ; "// Jump to Return Address " + ; "@R15" + ; "A=M" + ; "0;JMP" + ] diff --git a/compiler/backend/lib/return.mli b/compiler/backend/lib/return.mli new file mode 100644 index 0000000..146d0dd --- /dev/null +++ b/compiler/backend/lib/return.mli @@ -0,0 +1 @@ +val translate : string list diff --git a/compiler/backend/lib/translate.ml b/compiler/backend/lib/translate.ml new file mode 100644 index 0000000..a14fd84 --- /dev/null +++ b/compiler/backend/lib/translate.ml @@ -0,0 +1,27 @@ +open! Ast +open! Base + +let parse str = + let lexbuf = Lexing.from_string str in + Parser.prog Lexer.read lexbuf + +let bootstrap = + [ "@256"; "D=A"; "@SP"; "M=D" ] + @ Functioncall.translate Call "Sys.init" 0 + +let translate class_name lines : string list = + lines + |> List.map ~f:parse + |> List.bind ~f:(function + | ArithmeticCommand a + -> Arithmetic.translate a + | MemoryAccessCommand (command, segment, offset) + -> Memoryaccess.translate command segment offset class_name + | ProgramFlowCommand (command, name) + -> Programflow.translate command name + | FunctionCallCommand (command, name, arg) + -> Functioncall.translate command name arg + | Return + -> Return.translate + | Comment _ -> [] + ) diff --git a/compiler/backend/lib/translate.mli b/compiler/backend/lib/translate.mli new file mode 100644 index 0000000..a06efde --- /dev/null +++ b/compiler/backend/lib/translate.mli @@ -0,0 +1,10 @@ +open Ast + +(* Parse a string to the Ast.expr type. *) +val parse : string -> expr + +(* Set the Stack Pointer to 256 and call Sys.init function. *) +val bootstrap : string list + +(* Translate from parsed byte code [Ast.expr] to assembly *) +val translate : string -> string list -> string list diff --git a/compiler/test/dune b/compiler/backend/test/dune similarity index 100% rename from compiler/test/dune rename to compiler/backend/test/dune diff --git a/compiler/backend/test/test_backend.ml b/compiler/backend/test/test_backend.ml new file mode 100644 index 0000000..87377cf --- /dev/null +++ b/compiler/backend/test/test_backend.ml @@ -0,0 +1,31 @@ +open OUnit2 +open Backend.Ast +open Backend.Translate + +let peq case value = assert_equal value (parse case) + +let test_parse_a_command _ = + peq "add" (ArithmeticCommand Add); + peq "sub" (ArithmeticCommand Sub); + peq "neg" (ArithmeticCommand Neg); + peq "eq" (ArithmeticCommand Eq); + peq "gt" (ArithmeticCommand Gt); + peq "lt" (ArithmeticCommand Lt); + peq "and" (ArithmeticCommand And); + peq "or" (ArithmeticCommand Or); + peq "not" (ArithmeticCommand Not) +;; + +let test_parse_m_command _ = + peq "pop local 12" (MemoryAccessCommand (Pop, Local, 12)); + peq "push argument 4" (MemoryAccessCommand (Push, Argument, 4)) +;; + +let suite = + "suite" + >::: [ "A Instruction" >:: test_parse_a_command + ; "M Instruction" >:: test_parse_m_command + ] +;; + +let () = run_test_tt_main suite diff --git a/compiler/bin/compiler.ml b/compiler/bin/compiler.ml deleted file mode 100644 index 6a7ab6a..0000000 --- a/compiler/bin/compiler.ml +++ /dev/null @@ -1,32 +0,0 @@ -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 classname file = Filename.chop_extension (Filename.basename file) -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 (classname file) 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/dune-project b/compiler/dune-project deleted file mode 100644 index 8054eb6..0000000 --- a/compiler/dune-project +++ /dev/null @@ -1,2 +0,0 @@ -(lang dune 3.3) -(using menhir 2.0) diff --git a/compiler/lib/be_ast.ml b/compiler/lib/be_ast.ml deleted file mode 100644 index 94e21dc..0000000 --- a/compiler/lib/be_ast.ml +++ /dev/null @@ -1,4 +0,0 @@ -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 deleted file mode 100644 index 1e83d31..0000000 --- a/compiler/lib/be_lexer.mll +++ /dev/null @@ -1,57 +0,0 @@ -{ -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 deleted file mode 100644 index 3ed9b41..0000000 --- a/compiler/lib/be_parser.mly +++ /dev/null @@ -1,24 +0,0 @@ -%{ -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 deleted file mode 100644 index 1f36b0e..0000000 --- a/compiler/lib/be_predef.ml +++ /dev/null @@ -1,77 +0,0 @@ -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 push = [ "@SP"; "A=M"; "M=D"; "@SP"; "M=M+1" ] -let pop = [ "@R13"; "M=D"; "@SP"; "AM=M-1"; "D=M"; "@R13"; "A=M"; "M=D" ] - -let s_pointer = function - | "0" -> "@THIS" - | "1" -> "@THAT" - | _ -> failwith "Invalid Pointer" -;; - -let s_common = function - | "local" -> "@LCL" - | "this" -> "@THIS" - | "that" -> "@THAT" - | "argument" -> "@ARG" - | _ -> failwith "Invalid Segment" -;; - -let push_constant a = [ "@" ^ a; "D=A" ] @ push -let push_common a sp = [ "@" ^ a; "D=A"; s_common sp; "A=D+M"; "D=M" ] @ push -let push_temp a = [ "@" ^ a; "D=A"; "@R5"; "A=D+A"; "D=M" ] @ push -let push_pointer a = [ s_pointer a; "D=M" ] @ push -let push_static a cn = [ "@" ^ cn ^ "." ^ a; "D=M" ] @ push -let pop_common a sp = [ "@" ^ a; "D=A"; s_common sp; "D=D+M" ] @ pop -let pop_temp a = [ "@" ^ a; "D=A"; "@R5"; "D=D+A" ] @ pop -let pop_pointer a = [ "@SP"; "AM=M-1"; "D=M"; s_pointer a; "M=D" ] -let pop_static a cn = [ "@SP"; "AM=M-1"; "D=M"; "@" ^ cn ^ "." ^ a; "M=D" ] -let _end = [ "(TERMINATE)"; "@TERMINATE"; "0;JMP" ] diff --git a/compiler/lib/be_translate.ml b/compiler/lib/be_translate.ml deleted file mode 100644 index 94f8f60..0000000 --- a/compiler/lib/be_translate.ml +++ /dev/null @@ -1,65 +0,0 @@ -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 a_command loc 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 process_push cn sp a = - match sp with - | "local" | "argument" | "this" | "that" -> push_common a sp - | "constant" -> push_constant a - | "temp" -> push_temp a - | "static" -> push_static a cn - | "pointer" -> push_pointer a - | _ -> failwith "PROCESS PUSH: Invalid Segment" -;; - -let process_pop cn sp a = - match sp with - | "local" | "argument" | "this" | "that" -> pop_common a sp - | "temp" -> pop_temp a - | "static" -> pop_static a cn - | "pointer" -> pop_pointer a - | _ -> failwith "PROCESS POP: Invalid Segment" -;; - -let m_command cn (c, s, a) = - match c with - | "pop" -> process_pop cn s a - | "push" -> process_push cn s a - | _ -> failwith "m_command: Invalid Command" -;; - -let rec _translate expr cn loc tt = - match expr with - | [] -> tt - | Acommand a :: t -> a_command loc a @ _translate t cn (loc + 1) tt - | Mcommand (c, s, a) :: t -> m_command cn (c, s, a) @ _translate t cn loc tt - | _ :: t -> _translate t cn loc tt -;; - -let translate cn lines = - let exprs = generate_exprs lines in - _translate exprs cn 0 [] @ _end -;; diff --git a/compiler/lib/dune b/compiler/lib/dune deleted file mode 100644 index 2f40d16..0000000 --- a/compiler/lib/dune +++ /dev/null @@ -1,9 +0,0 @@ -(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/test_backend.ml b/compiler/test/test_backend.ml deleted file mode 100644 index 5001b92..0000000 --- a/compiler/test/test_backend.ml +++ /dev/null @@ -1,31 +0,0 @@ -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