Etape 4 ? à tester

This commit is contained in:
Nicolas PENELOUX 2023-12-18 13:08:33 +01:00
parent f7567888c9
commit 37e79d1df6

View file

@ -233,11 +233,15 @@ let translate (p : S.t) env =
| S.RecFunctions _ -> failwith "Students! This is your job (S.RecFunctions)!")
| S.Apply (a, bs) ->
(* 1.3 (4) *)
(*
let afs, a = expression env a in
let bsfs, bs = expressions env bs in
(* 1.4
TODO *)
afs @ bsfs, T.UnknownFunCall (a, bs)
*)
apply env a bs
| S.IfThenElse (a, b, c) ->
let afs, a = expression env a in
let bfs, b = expression env b in
@ -312,6 +316,7 @@ let translate (p : S.t) env =
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 ->
@ -319,27 +324,68 @@ let translate (p : S.t) env =
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
(* 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 =
(*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
(*Ensuite, on s'occupe d'écrire dans chaque bloc de notre cloture les variables libres*)
let env, vars_free, k =
List.fold_left (fun(env,list,k) id ->
List.fold_left (fun(env,list,k) id -> (*Pour chaque élément de la liste ...*)
(*On commence par lié la variable dans le nouvelle environnement qui se trouve dans l'ancien environnement*)
let new_env = bind_var env id (read_block (T.Variable (T.Id "oldenvironment")) (lint k)) in
(*On cherche la valeur de la variable dans le dictionnaire du programme*)
let new_valeur =
match Dict.lookup id env.vars with
| None -> T.Variable (identifier id)
| Some v -> v in
(*Enfin, on écrit dans notre cloture la valeur de la variable libre à la position k*)
let new_instr = write_block env_var (lint k) new_valeur in
(*On rappelle notre fonction avec le nouvelle environnement, en rajoutant notre instruction à la liste d'instruction, et en incrémentant l'index*)
(new_env, new_instr::list, k+1)
)
(*On commence notre fonction avec l'env de base, la liste d'instruction vide et l'indice à 1 (0 étant l'initialisation du début)*)
(env,[],1)
free_vars 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
seqs instrs, env
(* Fonction qui s'occupe de S.Apply*)
(* Revoir les explications c'est pas clair*)
and apply env f arguments =
(*D'abord, on traduit chaque arguments *)
let trad_argument argument = expression env argument in
let defs_args, trad_arguments = List.split (List.map trad_argument arguments) in
(*On créé un FunCall en fonction de f*)
match f with
| S.Variable x when (Dict.lookup x env.externals <> None) -> (*Si f est une externe fonction, on créé directement un FunCall*)
[], T.FunCall (function_identifier x, trad_arguments)
| _ -> (* SInon, ça veut dire que nous l'avons défini au préalable*)
(*On traduit la fonction*)
let defs_func, func = expression env f in
(* On récupère le nom de fonction et son expression*)
let fname, func_expr =
match func with
| T.Variable x -> x, (fun x -> x)
| _ ->
let fname = make_fresh_variable () in
fname, (fun x -> T.Define (fname,func,x))
in
(*On récupère le pointeur qui pointe vers la première case de la fonction*)
let get_pointer = read_block (T.Variable fname) (lint 0) in
(*On récupère l'appelle de la fonction*)
let defs_call = func_expr (T.UnknownFunCall (get_pointer,(T.Variable fname)::trad_arguments)) in
(*Enfin, on concatène toute les parties de la fonction (la traduction de tout les arguments)*)
let defs = defs_func @ List.concat defs_args in
defs, defs_call (* et on renvoie la def de la fonction ainsi que l'appel*)
in
program env p
;;