add baselib support

README.md

@@ -29,7 +29,7 @@ $ make test
 -   [x] Type `bool`
 -   [ ] Type `string`
 -   [x] Déclaration / assignation de variables
--   [ ] Librairie standard (multiplication, addition, comparateur, ...)
+-   [x] Librairie standard (multiplication, addition, comparateur, ...)
 -   [ ] Conditions
 -   [ ] Boucles
 -   [ ] Fonctions utilisateurs

ast.ml

@@ -1,6 +1,7 @@
 type type_t =
   | Int_t
   | Bool_t
+  | Func_t of type_t * type_t list
 
 module Syntax = struct
   type ident = string
@@ -18,6 +19,11 @@ module Syntax = struct
         { name : ident
         ; pos : Lexing.position
         }
+    | Call of
+        { func : ident
+        ; args : expr list
+        ; pos : Lexing.position
+        }
 
   type instr =
     | Decl of
@@ -48,6 +54,7 @@ module IR = struct
   type expr =
     | Val of value
     | Var of ident
+    | Call of ident * expr list
 
   type instr =
     | Decl of ident

baselib.ml

@@ -1,5 +1,12 @@
 open Ast
+open Mips
 module Env = Map.Make (String)
 
-let _types_ = Env.empty
-let builtins = []
+let _types_ = Env.of_seq (List.to_seq [ "%add", Func_t (Int_t, [ Int_t; Int_t ]) ])
+
+let builtins =
+  List.fold_left
+    (fun env (fn, impl) -> Env.add fn impl env)
+    Env.empty
+    [ "%add", [ Lw (T0, Mem (SP, 0)); Lw (T1, Mem (SP, 4)); Add (V0, T0, T1) ] ]
+;;

compiler.ml

@@ -15,9 +15,16 @@ let compile_value = function
   | Bool b -> [ Li (V0, if b then 1 else 0) ]
 ;;
 
-let compile_expr env = function
+let rec compile_expr env = function
   | Val v -> compile_value v
   | Var v -> [ Lw (V0, Env.find v env) ]
+  | Call (f, args) ->
+    let ca =
+      List.map
+        (fun a -> compile_expr env a @ [ Addi (SP, SP, -4); Sw (V0, Mem (SP, 0)) ])
+        args
+    in
+    List.flatten ca @ Env.find f Baselib.builtins
 ;;
 
 let compile_instr info = function
@@ -62,5 +69,5 @@ let compile_body body counter =
 
 let compile ir =
   let asm = compile_body ir 0 in
-  { text = Baselib.builtins @ asm; data = [] }
+  { text = asm; data = [] }
 ;;

lexer.mll

@@ -21,6 +21,7 @@ rule token = parse
 | bool as b     { Lbool (bool_of_string b) }
 | '='           { Lassign }
 | ';'           { Lsc }
+| '+'           { Ladd}
 | ident as i    { Lvar i }
 | '#'           { comment lexbuf }
 | _ as c        { raise (Error c) }

parser.mly

@@ -8,6 +8,9 @@
 %token <Ast.type_t> Ltype
 %token <string> Lvar
 %token Lend Lassign Lsc Lreturn
+%token Ladd
+
+%left Ladd
 
 %start prog
 
@@ -17,20 +20,20 @@
 
 prog:
   | Lend { [] }
-  | i = instr; Lsc; b = prog { i @ b }
+  | i = instr ; Lsc ; b = prog { i @ b }
 ;
 
 instr:
-  | Lreturn; e = expr { [ Return { expr = e ; pos = $startpos } ] }
-  | t = Ltype; v = Lvar {
-    [ Decl { name = v; type_t = t; pos = $startpos(t) } ]
+  | Lreturn ; e = expr { [ Return { expr = e ; pos = $startpos } ] }
+  | t = Ltype ; v = Lvar {
+    [ Decl { name = v ; type_t = t ; pos = $startpos(t) } ]
   }
-  | t = Ltype; v = Lvar; Lassign; e = expr
-    { [ Decl   { name = v; type_t = t; pos = $startpos(t) }
-    ; Assign { var = v; expr = e; pos = $startpos(v) } ]
+  | t = Ltype ; v = Lvar ; Lassign ; e = expr
+    { [ Decl   { name = v ; type_t = t ; pos = $startpos(t) }
+    ; Assign { var = v ; expr = e ; pos = $startpos(v) } ]
     }
-  | v = Lvar; Lassign; e = expr
-    { [ Assign { var = v; expr = e; pos = $startpos($2) } ]
+  | v = Lvar ; Lassign ; e = expr
+    { [ Assign { var = v ; expr = e ; pos = $startpos($2) } ]
     }
 
 expr:
@@ -43,4 +46,7 @@ expr:
   | v = Lvar {
     Var { name = v ; pos = $startpos(v) }
   }
+  | a = expr ; Ladd ; b = expr {
+    Call { func = "%add" ; args = [ a ; b ] ; pos = $startpos($2) }
+  }
 ;

semantics.ml

@@ -7,16 +7,22 @@ open Baselib
 exception Error of string * Lexing.position
 
 let errt expected given pos =
-  let str_of_type_t = function
+  let rec string_of_type_t = function
     | Int_t -> "int"
     | Bool_t -> "bool"
+    | Func_t (r, a) ->
+      (if List.length a > 1 then "(" else "")
+      ^ String.concat ", " (List.map string_of_type_t a)
+      ^ (if List.length a > 1 then ")" else "")
+      ^ " -> "
+      ^ string_of_type_t r
   in
   raise
     (Error
        ( Printf.sprintf
            "Expected %s but given %s"
-           (str_of_type_t expected)
-           (str_of_type_t given)
+           (string_of_type_t expected)
+           (string_of_type_t given)
        , pos ))
 ;;
 
@@ -35,7 +41,7 @@ let analyze_value = function
   | Syntax.Bool b -> Bool b, Bool_t
 ;;
 
-let analyze_expr env ua t = function
+let rec analyze_expr env ua t = function
   | Syntax.Val v ->
     let v2, new_t = analyze_value v.value in
     if new_t != t then errt t new_t v.pos;
@@ -47,6 +53,29 @@ let analyze_expr env ua t = function
     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
+  | Syntax.Call c ->
+    (match Env.find c.func env with
+    | Func_t (ret_t, tl) ->
+      if ret_t != t then errt t ret_t c.pos;
+      ( Call
+          ( c.func
+          , List.map2
+              (fun t e ->
+                let e2, t2 = analyze_expr env ua t e in
+                if t2 = t
+                then e2
+                else
+                  errt
+                    t
+                    t2
+                    (match e with
+                    | Syntax.Val v -> v.pos
+                    | Syntax.Var v -> v.pos
+                    | Syntax.Call c -> c.pos))
+              tl
+              c.args )
+      , ret_t )
+    | _ -> raise (Error ("\"" ^ c.func ^ "\" isn't a function", c.pos)))
 ;;
 
 let analyze_instr env ua = function
@@ -77,6 +106,8 @@ let emit oc ast =
   and fmt_e = function
     | Val v -> "Val (" ^ fmt_v v ^ ")"
     | Var v -> "Var \"" ^ v ^ "\""
+    | Call (f, a) ->
+      "Call (\"" ^ f ^ "\", [ " ^ String.concat " ; " (List.map fmt_e a) ^ " ])"
   and fmt_i = function
     | Decl v -> "Decl \"" ^ v ^ "\""
     | Assign (v, e) -> "Assign (\"" ^ v ^ "\", " ^ fmt_e e ^ ")"

tests/09_return.test

@@ -0,0 +1,2 @@
+int vie = 42;
+return vie;

tests/10_add.test

@@ -0,0 +1 @@
+int res = 1 + 1;