From 1acd0af73487ceff1ccc722caacf59bb6ee7364a Mon Sep 17 00:00:00 2001
From: Mylloon <kennel.anri@tutanota.com>
Date: Tue, 6 Dec 2022 20:39:15 +0100
Subject: [PATCH] add project startup

---
 ast.ml                | 10 ++++++++++
 baselib.ml            |  7 +++++++
 compiler.ml           | 12 ++++++++++++
 lexer.mll             | 15 +++++++++++++++
 main.ml               | 30 ++++++++++++++++++++++++++++++
 mips.ml               | 32 ++++++++++++++++++++++++++++++++
 parser.mly            | 23 +++++++++++++++++++++++
 semantics.ml          | 12 ++++++++++++
 tests/err-lex.test    |  1 +
 tests/err-syntax.test |  1 +
 tests/int.test        |  2 ++
 11 files changed, 145 insertions(+)
 create mode 100644 ast.ml
 create mode 100644 baselib.ml
 create mode 100644 compiler.ml
 create mode 100644 lexer.mll
 create mode 100644 main.ml
 create mode 100644 mips.ml
 create mode 100644 parser.mly
 create mode 100644 semantics.ml
 create mode 100644 tests/err-lex.test
 create mode 100644 tests/err-syntax.test
 create mode 100644 tests/int.test

diff --git a/ast.ml b/ast.ml
new file mode 100644
index 0000000..2135674
--- /dev/null
+++ b/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
diff --git a/baselib.ml b/baselib.ml
new file mode 100644
index 0000000..74f4715
--- /dev/null
+++ b/baselib.ml
@@ -0,0 +1,7 @@
+open Ast
+
+module Env = Map.Make(String)
+
+let _types_ = Env.empty
+
+let builtins = []
diff --git a/compiler.ml b/compiler.ml
new file mode 100644
index 0000000..18b54c5
--- /dev/null
+++ b/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 = [] }
diff --git a/lexer.mll b/lexer.mll
new file mode 100644
index 0000000..ff62844
--- /dev/null
+++ b/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) }
diff --git a/main.ml b/main.ml
new file mode 100644
index 0000000..8015f6f
--- /dev/null
+++ b/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
diff --git a/mips.ml b/mips.ml
new file mode 100644
index 0000000..e6f7497
--- /dev/null
+++ b/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
diff --git a/parser.mly b/parser.mly
new file mode 100644
index 0000000..3f3665c
--- /dev/null
+++ b/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) }
+}
+;
diff --git a/semantics.ml b/semantics.ml
new file mode 100644
index 0000000..0ff7f08
--- /dev/null
+++ b/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_
diff --git a/tests/err-lex.test b/tests/err-lex.test
new file mode 100644
index 0000000..8baef1b
--- /dev/null
+++ b/tests/err-lex.test
@@ -0,0 +1 @@
+abc
diff --git a/tests/err-syntax.test b/tests/err-syntax.test
new file mode 100644
index 0000000..65ea3ce
--- /dev/null
+++ b/tests/err-syntax.test
@@ -0,0 +1 @@
+1312 42
diff --git a/tests/int.test b/tests/int.test
new file mode 100644
index 0000000..415919b
--- /dev/null
+++ b/tests/int.test
@@ -0,0 +1,2 @@
+1312
+