ajout def_rec en théorie mais ça ne marche pas

flap/src/fopix/hobixToFopix.ml

@@ -209,7 +209,51 @@ let translate (p : S.t) env =
   and define_recursive_functions rdefs =
     (* 1.5
        TODO *)
-    failwith "Students! This is your job (define_recursive_functions)!"
+    (*failwith "Students! This is your job (define_recursive_functions)!"*)
+    
+    (*On récupère d'abord les informations qui nous intéresse : nom, variables libres, 
+       arguments, et le corps de la fonction récursive *)
+        let rdefs =(
+        let rname = List.map fst rdefs in 
+        let free_vars f = 
+          match f with 
+          | S.Fun(id, expr) ->
+            let new_id = id @ rname in 
+            let lfree_vars = free_variables (S.Fun(new_id, expr)) in
+            lfree_vars, id, expr 
+          | _ -> failwith "Error recFunctions : This is not a function"
+          in
+          List.map (fun (name, expr) -> name, free_vars expr) rdefs)
+        in
+
+        match rdefs with
+        | [name, (free_vars, arguments, expr)] ->
+          let defs, expre = fonction_anonyme env free_vars arguments expr in 
+          defs, [identifier name, expre]
+        | _ -> 
+          let rdefs =  creation_cloture_rec rdefs in
+          let fs, rdefs = List.split rdefs in
+          let trad_rdef = trad_rec_definition rdefs in
+          let fs', exprs = List.split trad_rdef in 
+          fs @ List.concat fs', exprs
+
+        
+  (*Fonction qui créé des clotures *)
+  and creation_cloture_rec rdefs = 
+    let nb = List.length rdefs -1 in 
+    List.map (fun (name, (free_vars, x, e)) ->
+      let new_name = make_fresh_variable () in
+      T.DefineValue (new_name, new_cloture nb free_vars), ((name, new_name), (free_vars, x, e))) rdefs
+
+  and trad_rec_definition rdefs = 
+    let rname = List.map fst rdefs in 
+    List.map
+    (fun ((name,new_name),(fv,x,e)) ->
+      let names = List.filter (fun (xi,_) -> xi != name) rname in
+      let defs, expr = fonction_anonyme ~name ~block:(new_name,names) env fv x e in
+      defs, (identifier name,expr))
+    rdefs
+
   and expression env = function
     | S.Literal l -> [], T.Literal (literal l)
     | S.While (cond, e) ->
@@ -243,19 +287,7 @@ let translate (p : S.t) env =
       let cfs, c = expression env c in
       afs @ bfs @ cfs, T.IfThenElse (a, b, c)
     | S.Fun (x, e) as f ->
-      (* (* 1.3 (3) *)
-      let fname = make_fresh_function_identifier () in
-      let x = List.map identifier x in
-      let efs, e = expression env e in
-      let ffs, f = expression env f in
-      (T.DefineFunction (fname, x, e) :: efs) @ ffs, f *)
-
-      (* TODO : Debug ce truc *)
-      let fname = make_fresh_function_identifier () in
-      let arguments_x = List.map identifier x in
-      let cloture, env = creation_cloture env fname (free_variables f) in
-      let dfs = add_liste_funcdef env fname arguments_x e in
-      dfs, cloture
+      fonction_anonyme env (free_variables f) x e 
     | S.AllocateBlock a ->
       let afs, a = expression env a in
       afs, allocate_block a
@@ -305,21 +337,38 @@ let translate (p : S.t) env =
   and add_liste_funcdef env fid x expr =
     let dfs, expr = expression env expr in
     dfs @ [ T.DefineFunction (fid, T.Id "oldenvironment" :: x, expr) ]
-  and creation_cloture env ?block fname free_vars =
+
+  and fonction_anonyme ?name ?block env f x e =
+    let fname = make_fresh_function_identifier () in
+      let arguments_x = List.map identifier x in
+      let cloture, env = creation_cloture env name block fname f in
+      let dfs = add_liste_funcdef env fname arguments_x e in
+      dfs, cloture
+
+  and creation_cloture env name block fname free_vars =  
+    let env = 
+    match name with 
+    | None -> env 
+    | Some name -> bind_var env name (T.Variable(T.Id "oldenvironment"))
+    in
     match block with
     | None ->
       let new_clot = new_cloture 0 free_vars in
       let blocks, env =
-        add_to_cloture env fname (T.Variable (T.Id "environment")) free_vars
+        add_to_cloture env fname (T.Variable (T.Id "environment")) free_vars []
       in
       T.Define (T.Id "environment", new_clot, blocks), env
-    | Some _ -> failwith "Students! This is your job (creation_cloture)!"
+    | Some (block, rdefs) -> 
+      add_to_cloture env fname (T.Variable block) free_vars rdefs
+
+
+
   (* Fonction qui initialise une cloture de taille espace
      + la taille de la liste de variable (le nombre de variable libre) *)
   and new_cloture espace list_variable =
     allocate_block (lint (espace + List.length list_variable + 1))
   (* Fonction qui rajoute à la cloture l'ensemble de variable libres *)
-  and add_to_cloture env fname env_var free_vars =
+  and add_to_cloture env fname env_var free_vars rdefs =
     (* On commence d'abord par écrire dans le premier bloc le nom de
        la fonction fopix *)
     let first_block = write_block env_var (lint 0) (T.Literal (T.LFun fname)) in
@@ -354,9 +403,22 @@ let translate (p : S.t) env =
         (env, [], 1)
         free_vars
     in
+    (*Dans le cas d'une récursion, on rajoute chaque fonction dans l'env et à la liste
+       d'instruction*)
+       let env,vars_fun,_ = 
+       List.fold_left (fun (env, list, k) (id, id_var) ->
+       let new_env =
+        bind_var env id (read_block (T.Variable (T.Id "oldenvironment")) (lint k))
+       in 
+       let new_instr = write_block env_var (lint k) (T.Variable id_var) in 
+       (new_env, new_instr::list,k+1)
+       )
+       (env,[],k) (*On commence avec k car on a mis k variables libres juste avant*)
+       rdefs
+      in
     (* On créé une séquence d'instructions contenant
        le premier bloc et la suite *)
-    let instrs = List.rev (env_var :: first_block :: vars_free) in
+    let instrs = List.rev (env_var :: first_block :: vars_free @ vars_fun) in
     seqs instrs, env
   (* 1.4
      TODO : Fonction qui s'occupe de S.Apply *)