Merge branch 'dev' of github.com:LucasVbr/postscript-compiler into dev

src/Makefile

@@ -1,5 +1,5 @@
-# Import lib + compile + clean folder
+# Import lib + compile
-all: lib comp clean
+all: lib comp
 
 # Compilation of Ocaml files
 # Attention: order of object files important 
@@ -51,10 +51,14 @@ parser.cmo: parser.ml parser.cmi lang.cmo
 
 .PHONY: clean
 
-### Import files from /lib
+### Import files from /lib (temporarly)
 lib:
 	cp ../lib/* ./
 
 ## Remove compiled modules and lib
 clean:
 	rm -f lexer.ml parser.ml *.mli *.cmi *.cmo
+
+## Run tests
+tests:
+	./comp ./../tests/rectangles.c ./../tests/out/rectangles.ps

src/typing.ml

@@ -1,38 +1,256 @@
 (* Typechecking of source programs *)
 
-open Lang
+open Lang;;
 
 (* Environments *)
 type environment = {
     localvars: (vname * tp) list; 
     funbind: fundecl list   
-}
+};;
 
-let find_var (var: vname) (env: environment) =
+(* Recherche dans l'environement *)
-    let rec aux local_vars = 
+type 'a option = None| Some of 'a;;
-        match local_vars with
+
-        | [] -> failwith "Variable inconnue"
+let findEnv_var (name: vname) (env: environment) =
-        | tete::reste -> 
+    let rec aux = function
-            let (name, _) = tete in
+    | [] -> None
-            if name = var
+    | (k, v)::reste ->
-            then tete
+        if k = name then Some(v)
-            else aux reste
+        else aux(reste)
-    in aux (env.localvars)
+    in aux(env.localvars)
 ;;
+(* val findEnv_var :
+   Lang.vname -> environment
+   -> Lang.tp option = <fun>
+*)
 
-(* let rec tp_expr (expression: expr) (env: environment) =
+let findEnv_fun (name: fname) (env: environment) =
+    let rec aux = function
+    | [] -> None
+    | Fundecl(tp, fname, vars)::reste ->
+        let f = (tp, fname, vars) in
+        if fname = name then Some(f)
+        else aux(reste)
+    in aux(env.funbind)
+;;
+(* val findEnv_fun :
+  Lang.fname -> environment
+  -> (Lang.tp * Lang.fname * Lang.vardecl list) option = <fun>
+*)
+
+let tp_vardecl (vdecl: vardecl) = 
+    let Vardecl(vdecl_tp, _) = vdecl
+    in vdecl_tp
+;;
+(* val tp_vardecl : Lang.vardecl -> Lang.tp = <fun> *)
+
+(* ----- Typage d'une expression ----- *)
+let rec tp_expr (env: environment) (expression: expr) =
     match expression with
-    | Const(const) -> 
+    | Const(const) -> (
-        match const with
+      match const with
-        | BoolV(_) -> BoolT
+      | BoolV _ -> BoolT
-        | FloatV(_) -> FloatT
+      | FloatV _ -> FloatT
-        | IntV(_) -> IntT
+      | IntV _ -> IntT
-        | LitV(_) -> LitT
+      | LitV _ -> LitT
-        | StringV(_) -> StringT
+      | StringV _ -> StringT
-    | VarE(var) -> tp_expr (find_var var env) env
+      )
-    | BinOp(op, expr1, expr2) -> 
+    | VarE(var) -> (
-    | CondE(expr1, expr2, expr3) -> 
+      let var_value = (findEnv_var var env) in
-    | CallE(functionName, exprList) ->  *)
+      match var_value with
+      | Some(value) -> value
+      | None -> raise (Failure "Unknown var")
+      )
+    | BinOp(op, expr1, expr2) ->
+        let tp_expr1 = tp_expr env expr1
+        and tp_expr2 = tp_expr env expr2 in
+        if tp_expr1 = tp_expr2
+        then (
+            match op with
+            | BArith(barith) -> (
+                match barith with
+                | BAadd -> IntT
+                | BAsub -> IntT
+                | BAmul -> IntT
+                | BAdiv -> IntT
+                | BAmod ->  IntT
+                | BAfadd -> FloatT 
+                | BAfsub -> FloatT
+                | BAfmul -> FloatT
+                | BAfdiv -> FloatT
+            )
+            | BBool(_) ->
+                if tp_expr1 = BoolT && tp_expr2 = BoolT
+                then BoolT
+                else raise (Failure "Invalid Boolean operation")
+            | BCompar(_) -> BoolT
+        )
+        else raise (Failure "Invalid type of Binary operation")
+    | CondE(expr1, expr2, expr3) ->
+        let tp_expr1 = tp_expr env expr1
+        and tp_expr2 = tp_expr env expr2
+        and tp_expr3 = tp_expr env expr3
+        in if tp_expr1 = BoolT && tp_expr2 = tp_expr3
+        then tp_expr2
+        else raise (Failure "Invalid type of Conditionnal Expression")
+    | CallE(name, list_expr) -> 
+        match (findEnv_fun name env) with
+        | Some(func) -> (
+            let (func_tp, func_name, func_list_vardecl) = func in
+            if (List.map (tp_expr env) list_expr) = (List.map tp_vardecl func_list_vardecl)
+            then func_tp
+            else raise (Failure "Invalid arguments")
+        )
+        | None -> raise (Failure "Unknown function in the environment")
+;;
+(* val tp_expr :
+   environment -> Lang.expr
+   -> Lang.tp = <fun>
+*)
+
+(* - tp_expr: TESTS - *)
+let test_tp_expr =
+    let function_to_test = tp_expr {
+        localvars=[
+            ("i", IntT);
+            ("f", FloatT);
+            ("b", BoolT);
+            ("l", LitT);
+            ("s", StringT);
+        ];
+        funbind=[
+            Fundecl(BoolT, "fun1", [Vardecl(IntT, "a"); Vardecl(FloatT, "b")])
+        ]
+    }
+    and input_values = [
+        Const(BoolV(true));
+        Const(FloatV(10.98));
+        Const(IntV(10));
+        Const(LitV("l"));
+        Const(StringV("Hello"));
+
+        VarE("b");
+        VarE("f");
+        VarE("i");
+        VarE("l");
+        VarE("s");
+        
+        BinOp(BArith(BAadd), Const(IntV(5)), VarE("i"));
+        BinOp(BArith(BAsub), Const(IntV(5)), VarE("i"));
+        BinOp(BArith(BAmul), Const(IntV(5)), VarE("i"));
+        BinOp(BArith(BAdiv), Const(IntV(5)), VarE("i"));
+        BinOp(BArith(BAmod), Const(IntV(5)), VarE("i"));
+
+        BinOp(BArith(BAfadd), Const(FloatV(5.)), VarE("f"));
+        BinOp(BArith(BAfsub), Const(FloatV(5.)), VarE("f"));
+        BinOp(BArith(BAfmul), Const(FloatV(5.)), VarE("f"));
+        BinOp(BArith(BAfdiv), Const(FloatV(5.)), VarE("f"));
+        
+        BinOp(BCompar(BCeq), VarE("i"), VarE("i"));
+        BinOp(BCompar(BCge), VarE("i"), VarE("i"));
+        BinOp(BCompar(BCgt), VarE("i"), VarE("i"));
+        BinOp(BCompar(BCle), VarE("i"), VarE("i"));
+        BinOp(BCompar(BClt), VarE("i"), VarE("i"));
+        BinOp(BCompar(BCne), VarE("i"), VarE("i"));
+
+        BinOp(BBool(BBand), VarE("b"), VarE("b"));
+        BinOp(BBool(BBor), VarE("b"), VarE("b"));
+
+        (* (4 >= 5) ? 7 : 8 -> IntT *)
+        CondE(
+            BinOp(BCompar(BCge), Const(IntV(4)), Const(IntV(5))),
+            Const(IntV(7)),
+            Const(IntV(8))
+        );
+
+        CallE("fun1", [VarE("i"); VarE("f")]);
+        (* CallE("fun2", [VarE("i"); VarE("f")]); *)
+        (* CallE("fun1", [VarE("b"); VarE("f")]); *)
+    ] and expected_result = [
+        BoolT; FloatT; IntT; LitT; StringT;
+        BoolT; FloatT; IntT; LitT; StringT;
+        IntT; IntT; IntT; IntT; IntT;
+        FloatT; FloatT; FloatT; FloatT;
+        BoolT; BoolT; BoolT; BoolT; BoolT; BoolT;
+        BoolT; BoolT;
+
+        IntT;
+        BoolT;
+    ] in
+    (List.map function_to_test input_values) = expected_result
 ;;
 
-let tp_prog (Prog (fundecls, fundefns)) = true
+(* ----- Typage d'une commande ----- *)
+let rec tp_cmd (env: environment) (cmd: com) =
+    match cmd with
+    | Skip -> VoidT
+    | Exit -> VoidT
+    | Assign(name, expr) -> VoidT
+    | Seq(cmd1, cmd2) ->
+        let tp_cmd1 = (tp_cmd env cmd1)
+        and tp_cmd2 = (tp_cmd env cmd2)
+        in if tp_cmd1 = VoidT
+        then tp_cmd2
+        else raise (Failure "Invalid type Sequence")
+    | CondC(expr1, cmd1, cmd2) ->
+        let tp_expr1 = tp_expr env expr1
+        and tp_cmd1 = tp_cmd env cmd1
+        and tp_cmd2 = tp_cmd env cmd2
+        in
+        if tp_expr1 = BoolT && tp_cmd1 = tp_cmd2
+        then tp_cmd1
+        else raise (Failure "Invalid type of Conditionnal Command")
+    | Loop(cmd1) ->
+        let _ = (tp_cmd env cmd1) in VoidT
+    | CallC(name, list_expr) -> tp_expr env (CallE(name, list_expr)) (* TODO => Question: Il faut renvoyer le type ??? *)
+    | Return(expr) -> (tp_expr env expr)
+;;
+(* val tp_cmd :
+   environment -> Lang.com
+   -> Lang.tp = <fun>
+*)
+
+(* - tp_cmd: TESTS - *)
+let test_tp_cmd =
+    let function_to_test = tp_cmd {
+        localvars=[
+            ("i", IntT);
+            ("f", FloatT);
+        ];
+        funbind=[
+            Fundecl(BoolT, "fun1", [Vardecl(IntT, "a"); Vardecl(FloatT, "b")])
+        ]
+    }
+    and input_values = [
+        Skip;
+        Exit;
+        Assign("test", Const(IntV(5)));
+        Seq(Skip, Exit);
+        Seq(Skip, Return(Const(FloatV(5.))));
+
+        CondC(
+            BinOp(BCompar(BCge), Const(IntV(4)), Const(IntV(5))),
+            Skip, Skip
+        );
+        Loop(Exit);
+
+        CallC("fun1", [VarE("i"); VarE("f")]);
+        Return(Const(IntV(5)));
+    ]
+    and expected_result = [
+        VoidT;
+        VoidT;
+        VoidT;
+        VoidT; FloatT;
+        VoidT;
+        VoidT;
+        BoolT;
+        IntT;
+    ] in
+    (List.map function_to_test input_values) = expected_result
+;;
+
+(* let tp_fundefn fundefns = ;; *)
+(* let tp_stmt fundecls = ;; *)
+
+let tp_prog (Prog (fundecls, fundefns)) = true;; (* try (tp_fundefn fundefns) && (tp_stmt fundecls) with _ -> false *)