From a6afabb53844acea4a3e896d4aab5257dca46e52 Mon Sep 17 00:00:00 2001 From: Mylloon Date: Mon, 18 Dec 2023 14:06:40 +0100 Subject: [PATCH] fmt --- flap/src/fopix/hobixToFopix.ml | 173 +++++++++++++++++---------------- 1 file changed, 90 insertions(+), 83 deletions(-) diff --git a/flap/src/fopix/hobixToFopix.ml b/flap/src/fopix/hobixToFopix.ml index 2c7471a..4a8884a 100644 --- a/flap/src/fopix/hobixToFopix.ml +++ b/flap/src/fopix/hobixToFopix.ml @@ -179,7 +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 } +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 = @@ -232,15 +232,10 @@ let translate (p : S.t) env = afs @ bfs, T.Define (identifier id, a, b) | S.RecFunctions _ -> failwith "Students! This is your job (S.RecFunctions)!") | S.Apply (a, bs) -> - (* 1.3 (4) *) - (* + (* (* 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) - *) + afs @ bsfs, T.UnknownFunCall (a, bs) *) apply env a bs | S.IfThenElse (a, b, c) -> let afs, a = expression env a in @@ -248,23 +243,19 @@ 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) - TODO: J'ai une boucle infini ici je comprends rien *) - (* + (* (* 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 + (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 @@ -307,85 +298,101 @@ 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 - - (*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 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 = + 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 - - (* fonction qui initialise une cloture de taille espace + la taille de la liste de variable (le nombre de variable libre)*) + | 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 + (* 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*) + (* 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*) + (* 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 -> (*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*) + 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 + (* 1.4 + TODO : 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 *) + (* 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*) + (* 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*) + | 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*) + | _ -> + (* 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*) - + (* 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 + (* Et on renvoie la def de la fonction ainsi que l'appel *) + defs, defs_call in program env p ;;