diff --git a/flap/src/fopix/hobixToFopix.ml b/flap/src/fopix/hobixToFopix.ml index 0a2ad77..d73ae21 100644 --- a/flap/src/fopix/hobixToFopix.ml +++ b/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 ;;