fmt
This commit is contained in:
parent
37e79d1df6
commit
a6afabb538
1 changed files with 90 additions and 83 deletions
|
@ -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 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 is_external id env = Dict.lookup id env.externals <> None
|
||||||
let reset_vars env = { env with vars = Dict.empty }
|
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]. *)
|
(** Precondition: [is_external id env = true]. *)
|
||||||
let arity_of_external id env =
|
let arity_of_external id env =
|
||||||
|
@ -232,15 +232,10 @@ let translate (p : S.t) env =
|
||||||
afs @ bfs, T.Define (identifier id, a, b)
|
afs @ bfs, T.Define (identifier id, a, b)
|
||||||
| S.RecFunctions _ -> failwith "Students! This is your job (S.RecFunctions)!")
|
| S.RecFunctions _ -> failwith "Students! This is your job (S.RecFunctions)!")
|
||||||
| S.Apply (a, bs) ->
|
| S.Apply (a, bs) ->
|
||||||
(* 1.3 (4) *)
|
(* (* 1.3 (4) *)
|
||||||
(*
|
|
||||||
let afs, a = expression env a in
|
let afs, a = expression env a in
|
||||||
let bsfs, bs = expressions env bs in
|
let bsfs, bs = expressions env bs in
|
||||||
(* 1.4
|
afs @ bsfs, T.UnknownFunCall (a, bs) *)
|
||||||
TODO *)
|
|
||||||
|
|
||||||
afs @ bsfs, T.UnknownFunCall (a, bs)
|
|
||||||
*)
|
|
||||||
apply env a bs
|
apply env a bs
|
||||||
| S.IfThenElse (a, b, c) ->
|
| S.IfThenElse (a, b, c) ->
|
||||||
let afs, a = expression env a in
|
let afs, a = expression env a in
|
||||||
|
@ -248,23 +243,19 @@ 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)
|
(* (* 1.3 (3) *)
|
||||||
TODO: J'ai une boucle infini ici je comprends rien *)
|
|
||||||
(*
|
|
||||||
let fname = make_fresh_function_identifier () in
|
let fname = make_fresh_function_identifier () in
|
||||||
let x = List.map identifier x in
|
let x = List.map identifier x in
|
||||||
let efs, e = expression env e in
|
let efs, e = expression env e in
|
||||||
let ffs, f = expression env f 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 *)
|
|
||||||
|
|
||||||
|
(* TODO : Debug ce truc *)
|
||||||
let fname = make_fresh_function_identifier () in
|
let fname = make_fresh_function_identifier () in
|
||||||
let arguments_x = List.map identifier x in
|
let arguments_x = List.map identifier x in
|
||||||
let cloture, env = creation_cloture env fname (free_variables f) in
|
let cloture, env = creation_cloture env fname (free_variables f) in
|
||||||
let dfs = add_liste_funcdef env fname arguments_x e in
|
let dfs = add_liste_funcdef env fname arguments_x e in
|
||||||
dfs, cloture
|
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
|
||||||
|
@ -308,84 +299,100 @@ let translate (p : S.t) env =
|
||||||
| S.LChar c -> T.LChar c
|
| S.LChar c -> T.LChar c
|
||||||
and identifier (S.Id x) = T.Id x
|
and identifier (S.Id x) = T.Id x
|
||||||
and function_identifier (S.Id x) = T.FunId x
|
and function_identifier (S.Id x) = T.FunId x
|
||||||
|
(* Ici, on rajoute notre fonction anonyme dans la liste des
|
||||||
(*Ici, on rajoute notre fonction anonyme dans la liste des définitions de fonctions*)
|
définitions de fonctions *)
|
||||||
|
(* Pas sûr pour les T.Id, pareil dans les autres fonctions d'ailleurs *)
|
||||||
(* Pas sûr pour les T.Id, pareil dans les autres fonctions d'ailleurs*)
|
|
||||||
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 creation_cloture env ?block fname free_vars =
|
||||||
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 = add_to_cloture env fname (T.Variable (T.Id "environment")) free_vars in
|
let blocks, env =
|
||||||
T.Define (T.Id "environment",new_clot,blocks), env
|
add_to_cloture env fname (T.Variable (T.Id "environment")) free_vars
|
||||||
|
in
|
||||||
(* fonction qui initialise une cloture de taille espace + la taille de la liste de variable (le nombre de variable libre)*)
|
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 =
|
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 =
|
||||||
(*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
|
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 =
|
let env, vars_free, k =
|
||||||
List.fold_left (fun(env,list,k) id -> (*Pour chaque élément de la liste ...*)
|
List.fold_left
|
||||||
(*On commence par lié la variable dans le nouvelle environnement qui se trouve dans l'ancien environnement*)
|
(fun (env, list, k) id ->
|
||||||
let new_env = bind_var env id (read_block (T.Variable (T.Id "oldenvironment")) (lint k)) in
|
(* Pour chaque élément de la liste ...
|
||||||
(*On cherche la valeur de la variable dans le dictionnaire du programme*)
|
On commence par lié la variable dans le nouvelle environnement
|
||||||
let new_valeur =
|
qui se trouve dans l'ancien environnement *)
|
||||||
match Dict.lookup id env.vars with
|
let new_env =
|
||||||
| None -> T.Variable (identifier id)
|
bind_var env id (read_block (T.Variable (T.Id "oldenvironment")) (lint k))
|
||||||
| Some v -> v in
|
in
|
||||||
(*Enfin, on écrit dans notre cloture la valeur de la variable libre à la position k*)
|
(* On cherche la valeur de la variable dans
|
||||||
let new_instr = write_block env_var (lint k) new_valeur in
|
le dictionnaire du programme *)
|
||||||
(*On rappelle notre fonction avec le nouvelle environnement, en rajoutant notre instruction à la liste d'instruction, et en incrémentant l'index*)
|
let new_valeur =
|
||||||
(new_env, new_instr::list, k+1)
|
match Dict.lookup id env.vars with
|
||||||
)
|
| None -> T.Variable (identifier id)
|
||||||
(*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)*)
|
| Some v -> v
|
||||||
(env,[],1)
|
in
|
||||||
|
(* Enfin, on écrit dans notre cloture la valeur de la variable libre
|
||||||
free_vars in
|
à la position k *)
|
||||||
(*On créé une séquence d'instructions contenant le premier bloc et la suite*)
|
let new_instr = write_block env_var (lint k) new_valeur in
|
||||||
let instrs = List.rev (env_var::first_block::vars_free) in
|
(* On rappelle notre fonction avec le nouvelle environnement,
|
||||||
seqs instrs, env
|
en rajoutant notre instruction à la liste d'instruction,
|
||||||
|
et en incrémentant l'index *)
|
||||||
|
new_env, new_instr :: list, k + 1)
|
||||||
(* Fonction qui s'occupe de S.Apply*)
|
(* On commence notre fonction avec l'env de base,
|
||||||
(* Revoir les explications c'est pas clair*)
|
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 =
|
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 trad_argument argument = expression env argument in
|
||||||
let defs_args, trad_arguments = List.split (List.map trad_argument arguments) 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
|
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)
|
[], 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
|
let defs_func, func = expression env f in
|
||||||
(* On récupère le nom de fonction et son expression*)
|
(* On récupère le nom de fonction et son expression *)
|
||||||
let fname, func_expr =
|
let fname, func_expr =
|
||||||
match func with
|
match func with
|
||||||
| T.Variable x -> x, (fun x -> x)
|
| T.Variable x -> x, fun x -> x
|
||||||
| _ ->
|
| _ ->
|
||||||
let fname = make_fresh_variable () in
|
let fname = make_fresh_variable () in
|
||||||
fname, (fun x -> T.Define (fname,func,x))
|
fname, fun x -> T.Define (fname, func, x)
|
||||||
in
|
in
|
||||||
(*On récupère le pointeur qui pointe vers la première case de la fonction*)
|
(* On récupère le pointeur qui pointe vers la première case
|
||||||
let get_pointer = read_block (T.Variable fname) (lint 0) in
|
de la fonction *)
|
||||||
(*On récupère l'appelle de la fonction*)
|
let get_pointer = read_block (T.Variable fname) (lint 0) in
|
||||||
let defs_call = func_expr (T.UnknownFunCall (get_pointer,(T.Variable fname)::trad_arguments)) in
|
(* On récupère l'appelle de la fonction *)
|
||||||
(*Enfin, on concatène toute les parties de la fonction (la traduction de tout les arguments)*)
|
let defs_call =
|
||||||
let defs = defs_func @ List.concat defs_args in
|
func_expr (T.UnknownFunCall (get_pointer, T.Variable fname :: trad_arguments))
|
||||||
defs, defs_call (* et on renvoie la def de la fonction ainsi que l'appel*)
|
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
|
in
|
||||||
program env p
|
program env p
|
||||||
;;
|
;;
|
||||||
|
|
Reference in a new issue