add assembler code

projects/06/assembler/.gitignore

@@ -0,0 +1 @@
+_build

projects/06/assembler/.ocamlformat

@@ -0,0 +1,2 @@
+profile = janestreet
+version = 0.23.0

projects/06/assembler/README.md

@@ -0,0 +1 @@
+

projects/06/assembler/bin/assembler.ml

@@ -0,0 +1,32 @@
+open Core
+open Hack
+
+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; ".hack"];;
+
+let gen_hack file =
+  let assembly = read_file file in
+  let binary = Translate.translate assembly in
+  let outchan = Out_channel.create (outfile file) in
+  Out_channel.output_lines outchan binary;
+  Out_channel.close outchan;
+;;
+
+let param =
+  let open Command.Param in
+    anon ("filename" %: string)
+;;
+
+let command =
+  Command.basic
+    ~summary:"Translate <filename>.asm to <filename>.hack"
+    ~readme: (fun () -> "Assembler for project 6 of Nand2Tetris")
+    (Command.Param.map param ~f:(fun filename ->
+          (fun () -> gen_hack filename)))
+;;
+
+let () = Command_unix.run command;;

projects/06/assembler/bin/dune

@@ -0,0 +1,3 @@
+(executable
+ (name assembler)
+ (libraries hack core core_unix.command_unix))

projects/06/assembler/dune-project

@@ -0,0 +1,2 @@
+(lang dune 3.3)
+(using menhir 2.0)

projects/06/assembler/lib/Ast.ml

@@ -0,0 +1,5 @@
+type expr =
+  | Comment of string
+  | Ginstr of string
+  | Ainstr of string
+  | Cinstr of string * string * string

projects/06/assembler/lib/Lexer.mll

@@ -0,0 +1,24 @@
+{
+open Parser
+}
+
+let white      = [' ' '\t']+
+let comment    = "//" _*
+let newline    = '\n' | '\r'
+let digit      = ['0'-'9']
+let letter     = ['a'-'z' 'A'-'Z']
+let special    = ['.' '$' '_' '-' '+' '&' '!' '|']
+let id         = (digit | letter | special)+
+
+
+rule read =
+  parse
+  | white          { read lexbuf }
+  | "@"            { AT }
+  | "("            { LPAREN }
+  | ")"            { RPAREN }
+  | ";"            { SCOLON }
+  | "="            { EQUALS }
+  | comment as c   { COMMENT (c) }
+  | id as id       { ID (id) }
+  | eof            { EOF }

projects/06/assembler/lib/Parser.mly

@@ -0,0 +1,30 @@
+%{
+open Ast
+%}
+
+%token <string> ID
+%token <string> COMMENT
+%token AT
+%token LPAREN
+%token RPAREN
+%token SCOLON
+%token EQUALS
+%token EOF
+
+%start <Ast.expr> prog
+
+%%
+
+prog:
+  | e = expr; EOF { e }
+  ;
+
+expr:
+  | c = COMMENT                   { Comment c }
+  | AT; a = ID;                   { Ainstr a }
+  | LPAREN; s = ID; RPAREN        { Ginstr s }
+  | c = ID; SCOLON; j = ID        { Cinstr ("", c, j) }
+  | d = ID; EQUALS; c = ID        { Cinstr (d, c, "") }
+  | c = ID;                       { Cinstr ("", c, "") } 
+  | e = expr; COMMENT             { e }
+  ;

projects/06/assembler/lib/Predef.ml

@@ -0,0 +1,85 @@
+open Base
+let symbols = Map.of_alist_exn (module String) [
+    "R0",     0;
+    "R1",     1;
+    "R2",     2;
+    "R3",     3;
+    "R4",     4;
+    "R5",     5;
+    "R6",     6;
+    "R7",     7;
+    "R8",     8;
+    "R9",     9;
+    "R10",    10;
+    "R11",    11;
+    "R12",    12;
+    "R13",    13;
+    "R14",    14;
+    "R15",    15;
+    "SP",     0;
+    "LCL",    1;
+    "ARG",    2;
+    "THIS",   3;
+    "THAT",   4;
+    "SCREEN", 16384;
+    "KBD",    24576;
+  ]
+
+let comp c =
+  match c with
+  | "0"   -> "0101010"
+  | "1"   -> "0111111"
+  | "-1"  -> "0111010"
+  | "D"   -> "0001100"
+  | "A"   -> "0110000"
+  | "M"   -> "1110000"
+  | "!D"  -> "0001101"
+  | "!A"  -> "0110001"
+  | "!M"  -> "1110001"
+  | "-D"  -> "0001111"
+  | "-A"  -> "0110011"
+  | "-M"  -> "1110011"
+  | "D+1" -> "0011111"
+  | "A+1" -> "0110111"
+  | "M+1" -> "1110111"
+  | "D-1" -> "0001110"
+  | "A-1" -> "0110010"
+  | "M-1" -> "1110010"
+  | "D+A" -> "0000010"
+  | "D+M" -> "1000010"
+  | "D-A" -> "0010011"
+  | "D-M" -> "1010011"
+  | "A-D" -> "0000111"
+  | "M-D" -> "1000111"
+  | "D&A" -> "0000000"
+  | "D&M" -> "1000000"
+  | "D|A" -> "0010101"
+  | "D|M" -> "1010101"
+  | _ -> failwith "Unknown COMP Instruction"
+;;
+
+let dest d =
+  match d with
+  | ""    -> "000"
+  | "M"   -> "001"
+  | "D"   -> "010"
+  | "MD"  -> "011"
+  | "A"   -> "100"
+  | "AM"  -> "101"
+  | "AD"  -> "110"
+  | "ADM" -> "111"
+  | _ -> failwith "Unknown DEST Instruction"
+;;
+
+let jump j =
+  match j with
+  | ""    -> "000"
+  | "JGT" -> "001"
+  | "JEQ" -> "010"
+  | "JGE" -> "011"
+  | "JLT" -> "100"
+  | "JNE" -> "101"
+  | "JLE" -> "110"
+  | "JMP" -> "111"
+  | _ -> failwith "Unknown JUMP Instruction"
+;;

projects/06/assembler/lib/Translate.ml

@@ -0,0 +1,82 @@
+open Base
+open Ast
+open Predef
+
+(* Check if symbol(k) exists in map(map), add it if it does not. *)
+let add_symbol map k d = 
+  if Map.mem map k then map 
+  else Map.add_exn map ~key:k ~data:d
+;;
+
+(* First Pass. FIXME *)
+let rec first_pass exprs st loc =
+  match exprs with
+  | [] -> st
+  | (Ginstr s)::t -> first_pass t (add_symbol st s loc) loc
+  | (Ainstr _ | Cinstr _ )::t -> first_pass t st (loc + 1)
+  | _::t -> first_pass t st loc
+;;
+
+(* Second Pass. FIXME *)
+let rec second_pass exprs st loc =
+  let is_new s = 
+    try Int.of_string s |> ignore; false
+    with Failure _ -> not (Map.mem st s) in
+  match exprs with
+  | [] -> st
+  | (Ainstr a)::t when (is_new a) -> second_pass t (add_symbol st a loc) (loc + 1)
+  | _::t -> second_pass t st loc 
+  ;;
+
+(* Decimal to Binary . FIXME *)
+let translate_ainstr addr st =
+  let to_int addr = 
+    try Map.find_exn st addr
+    with Not_found_s _ -> Int.of_string addr in
+  let pad binary = 
+    let length = 16 - String.length binary in
+    let prefix = String.init length ~f:(fun _ -> '0') in
+    String.concat [prefix; binary] in  
+  let rec to_binary a =
+    match a with
+    | 0 -> ""
+    | _ ->
+      let rem = a % 2 in
+      match rem with
+      | 0 -> to_binary (a / 2) ^ "0"
+      | _ -> to_binary (a / 2) ^ "1" in  
+  pad (to_binary (to_int addr))
+;;
+
+let translate_cinstr (d, c, j) = 
+  String.concat ["111"; comp c; dest d; jump j]
+;;
+
+let rec _translate exprs st tt = 
+  match exprs with
+  | [] -> tt
+  | (Ainstr a)::t -> translate_ainstr a st :: _translate t st tt
+  | (Cinstr (d, c, j))::t -> translate_cinstr (d, c, j) :: _translate t st tt
+  | _::t -> _translate t st tt
+;;
+
+let parse s =
+  let lexbuf = Lexing.from_string s in
+  let ast = Parser.prog Lexer.read lexbuf in 
+  ast
+;;
+
+let generate_exprs lines = 
+  List.map lines ~f:parse
+;;
+
+let generate_st exprs = 
+  let _st = first_pass exprs symbols 0 in
+  second_pass exprs _st 16
+;;
+
+let translate lines = 
+  let exprs = generate_exprs lines in
+  let st = generate_st exprs in
+  _translate exprs st []
+;;

projects/06/assembler/lib/dune

@@ -0,0 +1,8 @@
+(ocamllex Lexer)
+
+(menhir
+ (modules Parser))
+
+(library
+ (name hack)
+ (libraries base core))