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

This commit is contained in:
Nicolas PENELOUX 2023-12-18 17:27:44 +01:00
parent 86e8cead3a
commit 68eec09b05

View file

@ -209,7 +209,51 @@ let translate (p : S.t) env =
and define_recursive_functions rdefs = and define_recursive_functions rdefs =
(* 1.5 (* 1.5
TODO *) 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 and expression env = function
| S.Literal l -> [], T.Literal (literal l) | S.Literal l -> [], T.Literal (literal l)
| S.While (cond, e) -> | S.While (cond, e) ->
@ -243,19 +287,7 @@ let translate (p : S.t) env =
let cfs, c = expression env c in let cfs, c = expression env c in
afs @ bfs @ cfs, T.IfThenElse (a, b, c) afs @ bfs @ cfs, T.IfThenElse (a, b, c)
| S.Fun (x, e) as f -> | S.Fun (x, e) as f ->
(* (* 1.3 (3) *) fonction_anonyme env (free_variables f) x e
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
| S.AllocateBlock a -> | S.AllocateBlock a ->
let afs, a = expression env a in let afs, a = expression env a in
afs, allocate_block a afs, allocate_block a
@ -305,21 +337,38 @@ let translate (p : S.t) env =
and add_liste_funcdef env fid x expr = and add_liste_funcdef env fid x expr =
let dfs, expr = expression env expr in let dfs, expr = expression env expr in
dfs @ [ T.DefineFunction (fid, T.Id "oldenvironment" :: x, expr) ] 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 match block with
| None -> | None ->
let new_clot = new_cloture 0 free_vars in let new_clot = new_cloture 0 free_vars in
let blocks, env = 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 in
T.Define (T.Id "environment", new_clot, blocks), env 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 (* Fonction qui initialise une cloture de taille espace
+ la taille de la liste de variable (le nombre de variable libre) *) + la taille de la liste de variable (le nombre de variable libre) *)
and new_cloture espace list_variable = and new_cloture espace list_variable =
allocate_block (lint (espace + List.length list_variable + 1)) allocate_block (lint (espace + List.length list_variable + 1))
(* Fonction qui rajoute à la cloture l'ensemble de variable libres *) (* 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 (* On commence d'abord par écrire dans le premier bloc le nom de
la fonction fopix *) la fonction fopix *)
let first_block = write_block env_var (lint 0) (T.Literal (T.LFun fname)) in 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) (env, [], 1)
free_vars free_vars
in 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 (* On créé une séquence d'instructions contenant
le premier bloc et la suite *) 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 seqs instrs, env
(* 1.4 (* 1.4
TODO : Fonction qui s'occupe de S.Apply *) TODO : Fonction qui s'occupe de S.Apply *)