summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Makefile2
-rw-r--r--src/main.ml9
-rwxr-xr-xsrc/test.sh16
-rw-r--r--src/typing.ml113
4 files changed, 70 insertions, 70 deletions
diff --git a/src/Makefile b/src/Makefile
index 30526f5..f045726 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -5,7 +5,7 @@ all: $(BIN)
$(BIN): main.byte
cp main.byte minic++
-main.byte: main.ml ast.ml parser.mly lexer.mll pretty.ml
+main.byte: main.ml ast.ml parser.mly lexer.mll pretty.ml typing.ml pretty_typing.ml
ocamlbuild main.byte
clean:
diff --git a/src/main.ml b/src/main.ml
index 35bd6e0..1a7d5b1 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -63,11 +63,14 @@ let () =
localisation (Lexing.lexeme_start_p buf);
eprintf "Parsing error.@.";
exit 1
- | Typing.Error (loc, msg) ->
+ | Typing.Error(msg) ->
+ eprintf "Typing error (unknown location): %s@." msg;
+ exit 2
+ | Typing.LocError (loc, msg) ->
localisation2 loc;
eprintf "%s@." msg;
- exit 1
+ exit 2
| _ ->
eprintf "Unexpected error...@.";
- exit 2
+ exit 3
diff --git a/src/test.sh b/src/test.sh
index 603b404..34a6997 100755
--- a/src/test.sh
+++ b/src/test.sh
@@ -34,3 +34,19 @@ for a in ../tests/exec/*.cpp; do
else echo "FAIL $a";
fi;
done;
+
+echo "---"
+echo "Testing TYPING/GOOD for typing"
+for a in ../tests/typing/good/*.cpp; do
+ if ./main.byte $a;
+ then echo "OK $a";
+ else echo "FAIL $a";
+ fi;
+done;
+
+for a in ../tests/typing/bad/*.cpp; do
+ if ./main.byte $a 2> /dev/null;
+ then echo "FAIL $a";
+ else echo "OK $a";
+ fi;
+done;
diff --git a/src/typing.ml b/src/typing.ml
index 4d5b0c2..407c1d4 100644
--- a/src/typing.ml
+++ b/src/typing.ml
@@ -1,10 +1,16 @@
open Ast
-exception Er_ident of ident (* i n'a pas de type, semble impossible au parser *)
-exception Er_tident_use
-exception Er_double_ref
-exception Er_ref_use
-exception Error of loc * string
+exception LocError of loc * string
+exception Error of string
+
+let er_ident i = raise (Error ("Unknown identifier " ^ i))
+let er_ident_loc i loc = raise (LocError (loc, "Unknown identifier " ^ i))
+let er_not_a_variable i = raise (Error ("Expected '"^i^"' to be a variable"))
+let er_not_a_function i = raise (Error ("Expected '"^i^"' to be a function"))
+let er_tident_use () = raise (Error ("Er_tident_use"))
+let er_double_ref () = raise (Error ("Er_double_ref"))
+let er_ref_use ()= raise (Error ("Er_ref_use"))
+let er_not_implemented () = raise (Error ("Not implemented"))
type typ =
| T_Int
@@ -21,7 +27,6 @@ type texpression = {
te_desc: texpr_desc;
type_expr : typ*bool*bool; (* Type, référence?, valeur gauche? *)
}
-
and texpr_desc =
| TEInt of int
| TENull
@@ -35,23 +40,17 @@ and texpr_desc =
| TEMember of texpression * ident
| TENew of tident * texpression list
-type type_and_string =
- | Typ of type_ref
- | String
-
-
type tstr_expression =
| TSEExpr of texpression
| TSEStr of string
-module Tstm = Map.Make(String) (* string -> env *)
+module Smap = Map.Make(String)
-type stmt = mem Tstm.t
-and tstatement = {
+type tstatement = {
ts_loc: loc;
ts_desc: ts_desc;
- type_stm : stmt; }
+ }
and ts_desc =
| TSEmpty
| TSExpr of texpression
@@ -75,12 +74,11 @@ and tproto = {
tp_args : (type_ref * ident) list;
}
-and mem = (* type d'une expression *)
+type mem = (* type d'une expression *)
| Var of type_ref
| Fun of tproto * tblock
| Env of stmt (* statement type *)
-
-module Tmem = Map.Make(String) (* string -> mem *)
+and stmt = mem Smap.t (* string -> env *)
type tcls_mem =
| TCVar of var_type * ident
@@ -104,26 +102,25 @@ type tprogram = tdeclaration list
(* Quelques fonctions utiles : *)
let find_v i env =
- match Tmem.find i env with
+ match Smap.find i env with
| Var tr -> tr
- | _ -> failwith "N'est pas une variable définie"
+ | _ -> er_not_a_variable i
let find_f i env =
- match Tmem.find i env with
+ match Smap.find i env with
| Fun (p,t) -> (p,t)
- | _ -> failwith "N'est pas une fonction définie"
+ | _ -> er_not_a_function i
let same_type t1 t2 = (* types mem *)
let tr1 = (match t1 with
| Var (typ,_) -> typ
- | _ -> failwith "Pas un type de variable" ) in
+ | _ -> er_not_a_variable "") in
let tr2 = (match t2 with
| Var (typ,_) -> typ
- | _ -> failwith "Pas un type de variable" ) in
+ | _ -> er_not_a_variable "") in
tr1 = tr2
-(* true si bien formé *)
-let rec bf = function
+let rec bf = function (* true si bien formé *)
| T_Int -> true
| TClass _ -> true
| TPoint t -> bf t
@@ -142,11 +139,11 @@ let build_type_or_ref vt = (* vt -> typ,bool = tr, true si ref *)
| TPtr vt -> TPoint (see vt)
| TVoid -> T_Void
| TInt -> T_Int
- | TRef _ -> raise Er_ref_use
- | TIdent tid -> raise Er_tident_use
+ | TRef _ -> er_ref_use()
+ | TIdent tid -> TClass tid
in
match vt with
- | TRef (TRef vt) -> raise Er_double_ref (* ... *)
+ | TRef (TRef vt) -> er_double_ref() (* ... *)
| TRef vt -> (see vt),true (* indique qu'il s'agit d'une ref *)
| vt -> (see vt),false
@@ -157,8 +154,10 @@ let rec type_expr env e = (* expression -> texpression *)
try
let d,(ty,b1,b2) = compute_type env e in
{ te_loc = e.e_loc; te_desc = d; type_expr = (ty,b1,b2) }
- with | Er_ident i -> raise (Error (e.e_loc,("Type of variable "^i^" not declared")))
- | _ -> raise (Error (e.e_loc,"Other"))
+ with
+ | Error(k) -> raise (LocError(e.e_loc, k))
+ | LocError(_, _) as e -> raise e
+ | _ -> raise (LocError (e.e_loc,"Other error"))
and get_expr0 env e = (* expression -> texpression,(ty,b1,b2) *)
let te = type_expr env e in
@@ -179,7 +178,7 @@ and compute_type env e = match e.e_desc with (* expression -> te_desc,(typ,ref?,
(try let ty,b = find_v i env in (* pb avec (i,bool) *)
assert (bf ty); (* règle champs p4 *)
TEIdent i,(ty,b,true)
- with Not_found -> raise (Er_ident i)
+ with Not_found -> er_ident i
)
| EAssign (e1,e2) -> let te1,(ty1,_,b3) = get_expr0 env e1 in
let te2,(ty2,_,_) = get_expr0 env e2 in
@@ -240,25 +239,12 @@ and compute_type env e = match e.e_desc with (* expression -> te_desc,(typ,ref?,
| ENew _ -> TEInt 0, (T_Int,false,false)
| EThis -> TEInt 0, (T_Int,false,false)
-(* let compute_type_str_expr env e = (* str_expression -> (tse_str*)
- match e.se_desc with
- | SEExpr e0 -> let te,(t,b,_) = compute_type env {e_loc = e.se_loc; e_desc = e0} in
- (TSEExpr te),(Typ (t,b))
- | SEStr s -> (TSEStr s),String
-
-let type_str_expr env e = (* str_expression -> tstr_expression *)
- let t_str_te,ty = compute_type_str_expr env e in
- { tse_loc = e.se_loc; tse_desc = t_str_te; type_str = ty }*)
(* Statements *)
let rec type_stm env s =
let d, ty = compute_type_stm env s in
- { ts_loc = s.s_loc; ts_desc = d; type_stm = ty }
-
-and get_stm env s = (* statement -> tstatement,tstm *)
- let ts = type_stm env s in
- (ts,ts.type_stm)
+ { ts_loc = s.s_loc; ts_desc = d }, ty
and compute_type_stm env s = match s.s_desc with (* statement -> ts_desc,stm_type *)
| SEmpty -> TSEmpty,env
@@ -269,8 +255,8 @@ and compute_type_stm env s = match s.s_desc with (* statement -> ts_desc,stm_typ
| SReturn (Some e0) -> let te,(ty,_) = get_expr env e0 in
TSReturn (Some te), env
| SIf (e,s1,s2) -> let te,(ty,_) = get_expr env e in
- let ts1,ty1 = get_stm env s1 in (* vérifs règle *)
- let ts2,ty2 = get_stm env s2 in
+ let ts1,ty1 = type_stm env s1 in (* vérifs règle *)
+ let ts2,ty2 = type_stm env s2 in
assert (ty = T_Int);
(TSIf (te,ts1,ts2)) , env
| SFor (el1,eopt,el3,s) -> let tel1 = List.map (type_expr env) el1 in (* et fait les vérifs pr e1 et e3 ? *)
@@ -281,25 +267,25 @@ and compute_type_stm env s = match s.s_desc with (* statement -> ts_desc,stm_typ
assert (ty = T_Int);
Some te)
in
- ignore( get_stm env s ); (* vérifie i *)
- let ts = type_stm env s in (* fait le truc d'avant aussi *)
+ ignore( type_stm env s ); (* vérifie i *)
+ let ts, _ = type_stm env s in (* fait le truc d'avant aussi *)
TSFor (tel1,teopt,tel3,ts) , env
(* traduire règles restantes du for*)
- | SWhile(e,s) -> let ts,tys = get_stm env s in
+ | SWhile(e,s) -> let ts,tys = type_stm env s in
let te,(ty,_) = get_expr env e in
TSWhile(te,ts),env
(* pq while n'est pas dans les règles données ? *)
| SDeclare(vt,i) -> let ty,b = build_type_or_ref vt in
assert (bf ty);
- assert (not (Tmem.mem i env) );
- let env0 = Tmem.add i (Var (ty,b)) env in
+ assert (not (Smap.mem i env) );
+ let env0 = Smap.add i (Var (ty,b)) env in
TSDeclare( (ty,b) ,i) , env0
| SDeclareAssignExpr(vt,i,e) -> let ty,b = build_type_or_ref vt in
assert (bf ty);
- assert (not (Tmem.mem i env));
+ assert (not (Smap.mem i env));
let te,(tye,_) = get_expr env e in
(* assert tye<ty;*)
- let env0 = Tstm.add i (Var (ty,b) ) env in
+ let env0 = Smap.add i (Var (ty,b) ) env in
TSDeclareAssignExpr( (ty,b) ,i,te) , env0
| SWriteCout(str_e_list) ->
let args =
@@ -316,7 +302,7 @@ and compute_type_stm env s = match s.s_desc with (* statement -> ts_desc,stm_typ
and build_block env b = (* utilisé ds compute_type_stm et def_global_fun *)
let two_stms (env,l) s =
- let ts,ty = get_stm env s in
+ let ts,ty = type_stm env s in
(ty,(ts::l)) in
let ty_final,ts_list = List.fold_left two_stms (env,[]) b in
(* verif si b bien typé (règle i1;i2) et construit le te-block*)
@@ -331,9 +317,6 @@ and get_block env b =
let get_fun env p b = (* p : proto b : block -> name,Fun( ...)*)
let name = p.p_name in
- (* let t = (match p.p_ret_type with
- | Some ty -> ty
- | None -> failwith "On traite les fonctions" ) in*)
let ty_args =
List.map (* liste des arguments tr*ident *)
(fun (vt,i) -> let tr = build_type_or_ref vt in
@@ -352,7 +335,7 @@ pour traiter les ref, en fait fait quand on appelle sur proto.p_args *)
List.iter (fun ((ty,_),_) -> assert( bf ty ) ) ty_args;
(* types st bf*)
let contexte = List.fold_left (* tr = (ty,ref?) *)
- (fun envir (tr,i) -> Tmem.add i (Var tr) envir)
+ (fun envir (tr,i) -> Smap.add i (Var tr) envir)
env
ty_args
in (* contexte ds l'instruction *)
@@ -364,24 +347,22 @@ pour traiter les ref, en fait fait quand on appelle sur proto.p_args *)
let compute_decl env = function
| DGlobal(t,i) -> let tr = build_type_or_ref t in
- (TDGlobal(tr,i)) , (Tmem.add i (Var tr) env)
+ (TDGlobal(tr,i)) , (Smap.add i (Var tr) env)
(* on voudrait une liste de ident pr decl plsr en meme temps *)
| DFunction (p,b) -> let name,tp,tb = get_fun env p b in
- (TDFunction (tp,tb) ) , (Tmem.add name (Fun (tp,tb)) env)
- | DClass c -> TDNothing,env
+ (TDFunction (tp,tb) ) , (Smap.add name (Fun (tp,tb)) env)
+ | DClass c -> er_not_implemented() (* TODO *)
let prog p =
let l = (
List.fold_left
(fun list decl -> let (td,env) = List.hd list in
(compute_decl env decl)::list )
- [(TDNothing,Tmem.empty)]
+ [(TDNothing,Smap.empty)]
p
) in
List.map fst l
-(* raise (Error (e.e_loc,("Type of variable "^i^" not declared")))
- | _ -> raise Error e.e_loc,("Other") *)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 16:22:25 +0000