add project startup

ast.ml

@@ -0,0 +1,10 @@
+module Syntax = struct
+  type expr =
+    | Int of { value: int
+             ; pos: Lexing.position }
+end
+
+module IR = struct
+  type expr =
+    | Int of int
+end

baselib.ml

@@ -0,0 +1,7 @@
+open Ast
+
+module Env = Map.Make(String)
+
+let _types_ = Env.empty
+
+let builtins = []

compiler.ml

@@ -0,0 +1,12 @@
+open Ast.IR
+open Mips
+
+module Env = Map.Make(String)
+
+let rec compile_expr e =
+  match e with
+  | Int n  -> [ Li (V0, n) ]
+
+let compile ir =
+  { text = Baselib.builtins @ compile_expr ir
+  ; data = [] }

lexer.mll

@@ -0,0 +1,15 @@
+{
+  open Lexing
+  open Parser
+
+  exception Error of char
+}
+
+let num = ['0'-'9']
+
+rule token = parse
+| eof             { Lend }
+| [ ' ' '\t' ]    { token lexbuf }
+| '\n'            { Lexing.new_line lexbuf; token lexbuf }
+| num+ as n       { Lint (int_of_string n) }
+| _ as c          { raise (Error c) }

main.ml

@@ -0,0 +1,30 @@
+(* ocamlbuild -use-menhir test.byte *)
+
+open Lexing
+open Ast
+
+let err msg pos =
+  Printf.eprintf "Error on line %d col %d: %s.\n"
+    pos.pos_lnum (pos.pos_cnum - pos.pos_bol) msg ;
+  exit 1
+
+let () =
+  if (Array.length Sys.argv) != 2 then begin
+      Printf.eprintf "Usage: %s <file>\n" Sys.argv.(0) ;
+      exit 1
+    end;
+  let f = open_in Sys.argv.(1) in
+  let buf = Lexing.from_channel f in
+  try
+    let parsed = Parser.prog Lexer.token buf in
+    close_in f ;
+    let ast = Semantics.analyze parsed in
+    let asm = Compiler.compile ast in
+    Mips.emit Stdlib.stdout asm
+  with
+  | Lexer.Error c ->
+     err (Printf.sprintf "unrecognized char '%c'" c) (Lexing.lexeme_start_p buf)
+  | Parser.Error ->
+     err "syntax error" (Lexing.lexeme_start_p buf)
+  | Semantics.Error (msg, pos) ->
+     err msg pos

mips.ml

@@ -0,0 +1,32 @@
+type reg =
+  | V0
+
+type label = string
+
+type instr =
+  | Li    of reg * int
+
+type directive =
+  | Asciiz of string
+
+type decl = label * directive
+
+type asm = { text: instr list ; data: decl list }
+
+let ps = Printf.sprintf (* alias raccourci *)
+
+let fmt_reg = function
+  | V0   -> "$v0"
+
+let fmt_instr = function
+  | Li (r, i) -> ps "  li %s, %d" (fmt_reg r) i
+
+let fmt_dir = function
+  | Asciiz (s) -> ps ".asciiz \"%s\"" s
+
+let emit oc asm =
+  Printf.fprintf oc ".text\n.globl main\nmain:\n" ;
+  List.iter (fun i -> Printf.fprintf oc "%s\n" (fmt_instr i)) asm.text ;
+  Printf.fprintf oc "  move $a0, $v0\n  li $v0, 1\n  syscall\n  jr $ra\n" ;
+  Printf.fprintf oc "\n.data\n" ;
+  List.iter (fun (l, d) -> Printf.fprintf oc "%s: %s\n" l (fmt_dir d)) asm.data

parser.mly

@@ -0,0 +1,23 @@
+%{
+  open Ast
+  open Ast.Syntax
+%}
+
+%token <int> Lint
+%token Lend
+
+%start prog
+
+%type <Ast.Syntax.expr> prog
+
+%%
+
+prog:
+| e = expr; Lend { e }
+;
+
+expr:
+| n = Lint {
+  Int { value = n ; pos = $startpos(n) }
+}
+;

semantics.ml

@@ -0,0 +1,12 @@
+open Ast
+open Ast.IR
+open Baselib
+
+exception Error of string * Lexing.position
+
+let rec analyze_expr expr env =
+  match expr with
+  | Syntax.Int n -> Int n.value
+
+let analyze parsed =
+  analyze_expr parsed Baselib._types_

tests/err-lex.test

@@ -0,0 +1 @@
+abc

tests/err-syntax.test

@@ -0,0 +1 @@
+1312 42

tests/int.test

@@ -0,0 +1,2 @@
+1312
+