From 68eec09b05650fd2d4ea25da49bcfd4341d1ee61 Mon Sep 17 00:00:00 2001 From: Nicolas PENELOUX Date: Mon, 18 Dec 2023 17:27:44 +0100 Subject: [PATCH] =?UTF-8?q?ajout=20def=5Frec=20en=20th=C3=A9orie=20mais=20?= =?UTF-8?q?=C3=A7a=20ne=20marche=20pas?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- flap/src/fopix/hobixToFopix.ml | 100 ++++++++++++++++++++++++++------- 1 file changed, 81 insertions(+), 19 deletions(-) diff --git a/flap/src/fopix/hobixToFopix.ml b/flap/src/fopix/hobixToFopix.ml index c6c570f..2adda4c 100644 --- a/flap/src/fopix/hobixToFopix.ml +++ b/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 *)