From d433aafc4f35a1aee8056922ca0fa6123014b01a Mon Sep 17 00:00:00 2001
From: Mylloon <kennel.anri@tutanota.com>
Date: Fri, 9 Dec 2022 14:14:33 +0100
Subject: [PATCH] wip (fn): add return

---
 ast.ml       |  5 +++++
 compiler.ml  | 25 +++++++++++++++++++++----
 lexer.mll    |  1 +
 parser.mly   |  6 ++----
 semantics.ml | 18 +++++++++++-------
 5 files changed, 40 insertions(+), 15 deletions(-)

diff --git a/ast.ml b/ast.ml
index 9a5ca57..3524e04 100644
--- a/ast.ml
+++ b/ast.ml
@@ -30,6 +30,10 @@ module Syntax = struct
         ; expr : expr
         ; pos : Lexing.position
         }
+    | Return of
+        { expr : expr
+        ; pos : Lexing.position
+        }
 
   and block = instr list
 end
@@ -48,6 +52,7 @@ module IR = struct
   type instr =
     | Decl of ident
     | Assign of ident * expr
+    | Return of expr
 
   and block = instr list
 end
diff --git a/compiler.ml b/compiler.ml
index f669e5c..18a35b5 100644
--- a/compiler.ml
+++ b/compiler.ml
@@ -6,6 +6,8 @@ type info =
   { asm : instr list
   ; env : loc Env.t
   ; fpo : int (* FP offset *)
+  ; cnt : int (* Counter *)
+  ; ret : string (* Return *)
   }
 
 let compile_value = function
@@ -25,6 +27,7 @@ let compile_instr info = function
     { info with
       asm = info.asm @ compile_expr info.env e @ [ Sw (V0, Env.find v info.env) ]
     }
+  | Return e -> { info with asm = info.asm @ compile_expr info.env e @ [ B info.ret ] }
 ;;
 
 let rec compile_block info = function
@@ -32,18 +35,32 @@ let rec compile_block info = function
   | i :: b -> compile_block (compile_instr info i) b
 ;;
 
-let compile_body body =
-  let compiled = compile_block { asm = []; env = Env.empty; fpo = 8 } body in
+let compile_body body counter =
+  let compiled =
+    compile_block
+      { asm = []
+      ; env = Env.empty
+      ; fpo = 8
+      ; cnt = counter + 1
+      ; ret = "ret" ^ string_of_int counter
+      }
+      body
+  in
   [ Addi (SP, SP, -compiled.fpo)
   ; Sw (RA, Mem (SP, compiled.fpo - 4))
   ; Sw (FP, Mem (SP, compiled.fpo - 8))
   ; Addi (FP, SP, compiled.fpo - 4)
   ]
   @ compiled.asm
-  @ [ Addi (SP, SP, compiled.fpo); Lw (RA, Mem (FP, 0)); Lw (FP, Mem (FP, -4)); Jr RA ]
+  @ [ Label compiled.ret
+    ; Addi (SP, SP, compiled.fpo)
+    ; Lw (RA, Mem (FP, 0))
+    ; Lw (FP, Mem (FP, -4))
+    ; Jr RA
+    ]
 ;;
 
 let compile ir =
-  let asm = compile_body ir in
+  let asm = compile_body ir 0 in
   { text = Baselib.builtins @ asm; data = [] }
 ;;
diff --git a/lexer.mll b/lexer.mll
index 52c1d14..620ec3e 100644
--- a/lexer.mll
+++ b/lexer.mll
@@ -15,6 +15,7 @@ rule token = parse
 | [ ' ' '\t' ]  { token lexbuf }
 | '\n'          { Lexing.new_line lexbuf; token lexbuf }
 | num+ as n     { Lint (int_of_string n) }
+| "return"      { Lreturn }
 | "int"         { Ltype (Int_t) }
 | "bool"        { Ltype (Bool_t) }
 | bool as b     { Lbool (bool_of_string b) }
diff --git a/parser.mly b/parser.mly
index 1fbcaf1..fe909be 100644
--- a/parser.mly
+++ b/parser.mly
@@ -5,12 +5,9 @@
 
 %token <int> Lint
 %token <bool> Lbool
-
 %token <Ast.type_t> Ltype
-
 %token <string> Lvar
-
-%token Lend Lassign Lsc
+%token Lend Lassign Lsc Lreturn
 
 %start prog
 
@@ -24,6 +21,7 @@ prog:
 ;
 
 instr:
+  | Lreturn; e = expr { [ Return { expr = e ; pos = $startpos } ] }
   | t = Ltype; v = Lvar {
     [ Decl { name = v; type_t = t; pos = $startpos(t) } ]
   }
diff --git a/semantics.ml b/semantics.ml
index 71c903f..a705e29 100644
--- a/semantics.ml
+++ b/semantics.ml
@@ -35,18 +35,18 @@ let analyze_value = function
   | Syntax.Bool b -> Bool b, Bool_t
 ;;
 
-let analyze_expr env ua x = function
+let analyze_expr env ua t = function
   | Syntax.Val v ->
-    let v2, t = analyze_value v.value in
-    if t != x then errt x t v.pos;
-    Val v2, t
+    let v2, new_t = analyze_value v.value in
+    if new_t != t then errt t new_t v.pos;
+    Val v2, new_t
   | Syntax.Var v ->
     if not (Env.mem v.name env)
     then raise (Error ("Unbound variable \"" ^ v.name ^ "\"", v.pos));
     if List.mem v.name ua then warn ("Unassigned variable \"" ^ v.name ^ "\"") v.pos;
-    let t = Env.find v.name env in
-    if t != x then errt x t v.pos;
-    Var v.name, t
+    let new_t = Env.find v.name env in
+    if new_t != t then errt t new_t v.pos;
+    Var v.name, new_t
 ;;
 
 let analyze_instr env ua = function
@@ -56,6 +56,9 @@ let analyze_instr env ua = function
     then raise (Error ("Unbound variable \"" ^ a.var ^ "\"", a.pos));
     let ae, et = analyze_expr env ua (Env.find a.var env) a.expr in
     Assign (a.var, ae), env, List.filter (fun x -> x <> a.var) ua
+  | Syntax.Return r ->
+    let ae, _ = analyze_expr env ua Int_t r.expr in
+    Return ae, env, []
 ;;
 
 let rec analyze_block env ua = function
@@ -77,6 +80,7 @@ let emit oc ast =
   and fmt_i = function
     | Decl v -> "Decl \"" ^ v ^ "\""
     | Assign (v, e) -> "Assign (\"" ^ v ^ "\", " ^ fmt_e e ^ ")"
+    | Return e -> "Return (" ^ fmt_e e ^ ")"
   and fmt_b b = "[ " ^ String.concat "\n; " (List.map fmt_i b) ^ " ]" in
   Printf.fprintf oc "%s\n" (fmt_b ast)
 ;;