tp3

src/compilateur.ml

@@ -38,15 +38,14 @@ module CompilateurRat = Compilateur (PasseTdsNop) (PasseNop) (PasseNop) (PasseCo
 *)
 
 (* + passe de résolution des identifiants *)
-open PasseTdsRat
+(* open PasseTdsRat
-module CompilateurRat = Compilateur (PasseTdsRat) (PasseTypeNop) (PasseNop) (PasseCodeNopNop) 
+module CompilateurRat = Compilateur (PasseTdsRat) (PasseTypeNop) (PasseNop) (PasseCodeNopNop)  *)
 
 (* + passe de typage *)
-(*
 open PasseTdsRat
 open PasseTypeRat
 module CompilateurRat = Compilateur (PasseTdsRat) (PasseTypeRat) (PassePlacementNop) (PasseCodeNopNop)
-*)
+
 
 (* + passe de placement mémoire *)
 (*

src/passeTypeRat.ml

@@ -0,0 +1,185 @@
+(* Module de la passe de typage *)
+module PasseTypeRat : Passe.Passe with type t1 = Ast.AstTds.programme and type t2 = Ast.AstType.programme =
+struct
+
+  open Tds
+  open Exceptions
+  open Ast
+  open AstType
+
+  type t1 = Ast.AstTds.programme
+  type t2 = Ast.AstType.programme
+
+
+(* analyse_tds_expression : AstTds.expression -> (AstType.expression, type) *)
+(* Paramètre tds : la table des symboles courante *)
+(* Paramètre e : l'expression à analyser *)
+(* Vérifie la bonne utilisation des identifiants et tranforme l'expression
+en une expression de type AstType.expression *)
+(* Erreur si mauvaise utilisation des identifiants *)
+let rec analyse_type_expression e =
+  match e with
+  | AstTds.AppelFonction(info, l_expr) ->
+  begin
+    let n_l_expr, l_type = List.split (List.map analyse_type_expression l_expr) in
+    let InfoFun(_, t, l_type_fun) = info_ast_to_info info in
+    if (est_compatible_list l_type_fun l_type) then
+      (AstType.AppelFonction(info, n_l_expr), t)
+    else
+      raise TypesParametresInattendus(l_type_fun, l_type)
+  end
+
+  | AstTds.Unaire(u, expr) ->
+  begin
+    match (analyse_type_expression expr) with
+    | n_expr, Rat ->
+      match u with
+      | AstSyntax.Numerateur -> (AstType.Unaire(Numerateur, n_expr), Int)
+      | AstSyntax.Denominateur -> (AstType.Unaire(Denominateur, n_expr), Int)
+    | _, t -> raise (TypeInattendu(Rat, t))
+  end
+
+  | AstTds.Binaire(b, expr_1, expr_2) ->
+  begin
+    let (n_expr_1, t1) = analyse_type_expresseion expr_1 in
+    let (n_expr_2, t2) = analyse_type_expresseion expr_2 in
+    match (b, t1, t2) with
+    | Fraction, Int, Int -> (AstType.Binaire(Fraction, n_expr_1, n_expr_2), Rat)
+    | Plus, Int, Int -> (AstType.Binaire(PlusInt, n_expr_1, n_expr_2), Int)
+    | Mult, Int, Int -> (AstType.Binaire(MultInt, n_expr_1, n_expr_2), Int)
+    | Equ, Int ,Int -> (AstType.Binaire(EquInt, n_expr_1, n_expr_2), Int)
+    | Inf, Int, Int -> (AstType.Binaire(Inf, n_expr_1, n_expr_2), Int)
+    | Plus, Rat, Rat -> (AstType.Binaire(PlusRat, n_expr_1, n_expr_2), Rat)
+    | Mult, Rat, Rat -> (AstType.Binaire(MultRat, n_expr_1, n_expr_2), Rat)
+    | Equ, Bool ,Bool -> (AstType.Binaire(EquBool, n_expr_1, n_expr_2), Bool)
+    | _,_,_ -> raise (TypeBinaireInattendu(b, t1, t2))
+  end
+
+  | AstTds.Ident(info) ->
+  begin
+    match (info_ast_to_info info) with
+    | InfoVar(_, t, _, _) -> (AstType.Ident(info), t)
+    | InfoConst(_, _) -> (AstType.Ident(info), Int)
+  end
+
+  | AstTds.Booleen(b) -> (AstType.Booleen(b), Bool)
+
+  | AstTds.Entier(i) -> (AstType.Entier(i), Int)
+
+(* analyse_tds_instruction : AstTds.instruction -> tds -> AstType.instruction *)
+(* Paramètre tds : la table des symboles courante *)
+(* Paramètre i : l'instruction à analyser *)
+(* Vérifie la bonne utilisation des identifiants et tranforme l'instruction
+en une instruction de type AstType.instruction *)
+(* Erreur si mauvaise utilisation des identifiants *)
+let rec analyse_type_instruction tds i = failwith "TODO"
+  (* match i with
+  | AstTds.Declaration (t, info, e) ->
+    match analyse_type_expr e with
+    | (ne, nt) ->
+      if (est_compatible t nt) then
+        modifier_type_info t info
+        AstType.Declaration(info, e)
+      else
+        Raise TypeInattendu(t, nt)
+
+  | AstTds.Affectation (info, e) ->
+
+    AstType.Affectation (info, e)
+
+  | AstTds.Constante (n,v) ->
+
+  | AstTds.Affichage e ->
+
+  | AstTds.Conditionnelle (c,t,e) ->
+
+  | AstTds.TantQue (c,b) ->
+
+  | AstTds.Retour (e) -> *)
+
+
+
+(* analyse_tds_bloc : AstTds.bloc -> AstType.bloc *)
+(* Paramètre tds : la table des symboles courante *)
+(* Paramètre li : liste d'instructions à analyser *)
+(* Vérifie la bonne utilisation des identifiants et tranforme le bloc
+en un bloc de type AstType.bloc *)
+(* Erreur si mauvaise utilisation des identifiants *)
+and analyse_tds_bloc tds li =
+  (* Entrée dans un nouveau bloc, donc création d'une nouvelle tds locale
+  pointant sur la table du bloc parent *)
+  let tdsbloc = creerTDSFille tds in
+  (* Analyse des instructions du bloc avec la tds du nouveau bloc
+  Cette tds est modifiée par effet de bord *)
+   let nli = List.map (analyse_tds_instruction tdsbloc) li in
+   (* afficher_locale tdsbloc ; *) (* décommenter pour afficher la table locale *)
+   nli
+
+
+(* analyse_tds_fonction : AstTds.fonction -> AstType.fonction *)
+(* Paramètre tds : la table des symboles courante *)
+(* Paramètre : la fonction à analyser *)
+(* Vérifie la bonne utilisation des identifiants et tranforme la fonction
+en une fonction de type AstType.fonction *)
+(* Erreur si mauvaise utilisation des identifiants *)
+(*
+  tds ->
+  AstTds.fonction[typ * string * (typ * string) list * bloc] ->
+  AstType.fonction[typ * Tds.info_ast * (typ * Tds.info_ast ) list * bloc]
+*)
+let analyse_tds_fonction maintds (AstTds.Fonction(t, str, l_typstr, bloc))  =
+  begin
+    match chercherLocalement maintds str with
+    | Some _ -> raise (DoubleDeclaration str)
+    | None ->
+      begin
+        (* Info de l'identifiant de la fonction *)
+        let info = Tds.InfoVar(str, Undefined, 0, "") in
+
+        (* Copie de la tds globale dans la tds locale au bloc *)
+        let tds_bloc = creerTDSFille maintds in
+
+        (* Ajouter les arguments de la fonction dans la tds locale *)
+        let _ = (List.map (
+          fun (_, nom) ->
+            match chercherLocalement tds_bloc nom with
+            | None -> ajouter tds_bloc nom (info_to_info_ast (Tds.InfoVar(nom, Undefined, 0, "")))
+            (* Si un argument est en double, on lève une exception *)
+            | Some _ -> raise (DoubleDeclaration nom)
+        ) l_typstr) in
+
+        (* On ajoute a la tds locale la fonction pour qu'il puisse y avoir des appels récursifs *)
+        let _ = ajouter tds_bloc str (info_to_info_ast (Tds.InfoFun(str, t, (List.map (fun (t, _) -> t) l_typstr)))) in
+
+        (* On génère le nouveau bloc avec la tds locale *)
+        let new_bloc = analyse_tds_bloc tds_bloc bloc in
+
+        (* On transforme les (type * str) en (typ * info) *)
+        let nl_typinfo = List.map (
+          fun (t, str2) ->
+            ( t, info_to_info_ast (Tds.InfoVar(str2, Undefined, 0, "")) )
+          ) l_typstr in
+
+        (* On crée l'info de la fonction *)
+        let info_fun = InfoFun(str, t, (List.map (fun (t, _) -> t) l_typstr)) in
+
+        (* On ajoute la fonction a la tds globale *)
+        ajouter maintds str (info_to_info_ast info_fun);
+
+        (* On retourne la AstType fonction *)
+        AstType.Fonction(t, (info_to_info_ast info), nl_typinfo, new_bloc)
+      end
+  end
+
+(* analyser : AstTds.ast -> AstType.ast *)
+(* Paramètre : le programme à analyser *)
+(* Vérifie la bonne utilisation des identifiants et tranforme le programme
+en un programme de type AstType.ast *)
+(* Erreur si mauvaise utilisation des identifiants *)
+let analyser (AstTds.Programme (fonctions,prog)) =
+  let tds = creerTDSMere () in
+  let nf = List.map (analyse_tds_fonction tds) fonctions in
+  let nb = analyse_tds_bloc tds prog in
+  Programme (nf,nb)
+
+end

src/testType.ml

@@ -7,9 +7,9 @@ exception ErreurNonDetectee
 (* Sans fonction                  *)
 (* ------------------------------ *)
 
-(*
 let%test_unit "testDeclaration1"=
-  let _ = compiler "../../fichiersRat/src-rat-type-test/testDeclaration1.rat" in ()
+let _ = compiler "../../fichiersRat/src-rat-type-test/testDeclaration1.rat" in ()
+(*
 
 let%test_unit "testDeclaration2"=
   let _ = compiler "../../fichiersRat/src-rat-type-test/testDeclaration2.rat" in ()