mirror of
https://github.com/LucasVbr/postscript-compiler.git
synced 2026-05-13 17:22:00 +00:00
Merge branch 'dev' of github.com:LucasVbr/postscript-compiler into dev
This commit is contained in:
Laurian-Dufrechou
+7
-3
@@ -1,5 +1,5 @@
|
||||
# Import lib + compile + clean folder
|
||||
all: lib comp clean
|
||||
# Import lib + compile
|
||||
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
|
||||
+241
-23
@@ -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) =
|
||||
let rec aux local_vars =
|
||||
match local_vars with
|
||||
| [] -> failwith "Variable inconnue"
|
||||
| tete::reste ->
|
||||
let (name, _) = tete in
|
||||
if name = var
|
||||
then tete
|
||||
else aux reste
|
||||
in aux (env.localvars)
|
||||
(* Recherche dans l'environement *)
|
||||
type 'a option = None| Some of 'a;;
|
||||
|
||||
let findEnv_var (name: vname) (env: environment) =
|
||||
let rec aux = function
|
||||
| [] -> None
|
||||
| (k, v)::reste ->
|
||||
if k = name then Some(v)
|
||||
else aux(reste)
|
||||
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) ->
|
||||
match const with
|
||||
| BoolV(_) -> BoolT
|
||||
| FloatV(_) -> FloatT
|
||||
| IntV(_) -> IntT
|
||||
| LitV(_) -> LitT
|
||||
| StringV(_) -> StringT
|
||||
| VarE(var) -> tp_expr (find_var var env) env
|
||||
| Const(const) -> (
|
||||
match const with
|
||||
| BoolV _ -> BoolT
|
||||
| FloatV _ -> FloatT
|
||||
| IntV _ -> IntT
|
||||
| LitV _ -> LitT
|
||||
| StringV _ -> StringT
|
||||
)
|
||||
| VarE(var) -> (
|
||||
let var_value = (findEnv_var var env) in
|
||||
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) ->
|
||||
| CallE(functionName, exprList) -> *)
|
||||
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 *)
|
||||
Reference in New Issue
Block a user