[WIP] initial compiler backend code

compiler/lib/be_ast.ml

@@ -0,0 +1,4 @@
+type expr =
+  | Comment of string
+  | Acommand of string
+  | Mcommand of string * string * string

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 }

compiler/lib/be_parser.mly

@@ -0,0 +1,24 @@
+%{
+open Be_ast
+%}
+
+%token <string> ADDRESS
+%token <string> COMMAND
+%token <string> SEGMENT 
+%token <string> COMMENT
+%token EOF
+
+%start <Be_ast.expr> 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 }
+  ;

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"
+;;

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
+;;

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))