Etape S.Fun (ne marche surement pas)

flap/src/fopix/hobixToFopix.ml

@@ -179,6 +179,7 @@ let initial_environment () = { vars = Dict.empty; externals = Dict.empty }
 let bind_external id n env = { env with externals = Dict.insert id n env.externals }
 let is_external id env = Dict.lookup id env.externals <> None
 let reset_vars env = { env with vars = Dict.empty }
+let bind_var env id expr = {env with vars = Dict.insert id expr env.vars }
 
 (** Precondition: [is_external id env = true]. *)
 let arity_of_external id env =
@@ -245,11 +246,21 @@ let translate (p : S.t) env =
     | S.Fun (x, e) as f ->
       (* 1.3 (3)
          TODO: J'ai une boucle infini ici je comprends rien *)
+         (*
       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
+      (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
+      
+
     | S.AllocateBlock a ->
       let afs, a = expression env a in
       afs, allocate_block a
@@ -292,6 +303,43 @@ let translate (p : S.t) env =
     | S.LString s -> T.LString s
     | S.LChar c -> T.LChar c
   and identifier (S.Id x) = T.Id x
-  and function_identifier (S.Id x) = T.FunId x in
+  and function_identifier (S.Id x) = T.FunId x 
+
+  (*Ici, on rajoute notre fonction anonyme dans la liste des définitions de fonctions*)
+
+  (* Pas sûr pour les T.Id, pareil dans les autres fonctions d'ailleurs*)
+  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 = 
+    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 in
+      T.Define (T.Id "environment",new_clot,blocks), env
+    
+  and new_cloture espace list_variable =
+    allocate_block (lint (espace + List.length list_variable + 1))
+
+  and add_to_cloture env fname env_var free_vars =
+    let first_block = write_block env_var (lint 0) (T.Literal (T.LFun fname)) in
+    let env, vars_free, k =
+    List.fold_left (fun(env,list,k) id ->
+      let new_env = bind_var env id (read_block  (T.Variable (T.Id "oldenvironment")) (lint k)) in
+      let new_valeur = 
+        match Dict.lookup id env.vars with
+        | None -> T.Variable (identifier id)
+        | Some v -> v in
+      let new_instr = write_block env_var (lint k) new_valeur in
+      (new_env, new_instr::list, k+1)
+      )
+      (env,[],1)
+
+      free_vars in
+      let instrs = List.rev (env_var::first_block::vars_free) in
+      seqs instrs, env
+
+  in
   program env p
 ;;