ajout de commentaires
This commit is contained in:
parent
ec2816ddba
commit
e4b7a7bc0c
1 changed files with 29 additions and 7 deletions
|
@ -221,6 +221,13 @@ let translate (p : S.t) env =
|
||||||
| S.RecFunctions fdefs ->
|
| S.RecFunctions fdefs ->
|
||||||
let fs, defs = define_recursive_functions env fdefs in
|
let fs, defs = define_recursive_functions env fdefs in
|
||||||
fs @ List.map (fun (x, e) -> T.DefineValue (x, e)) defs
|
fs @ List.map (fun (x, e) -> T.DefineValue (x, e)) defs
|
||||||
|
|
||||||
|
(*Ce qu'il faut faire dans le cadre des fonctions mutuellement récursives :
|
||||||
|
- On récupère la liste des fonctions
|
||||||
|
- On créé des clotures pour chaque récursion
|
||||||
|
- On traduit chaque fonction mutuellement récursive en appel de fonction anonyme
|
||||||
|
- On finit par combiner chaque liste de définition, celle des la fonction de base,
|
||||||
|
puis celle des des fonctions traduites. *)
|
||||||
and define_recursive_functions env rdefs =
|
and define_recursive_functions env rdefs =
|
||||||
|
|
||||||
(*On récupère d'abord les informations qui nous intéresse : nom, variables libres,
|
(*On récupère d'abord les informations qui nous intéresse : nom, variables libres,
|
||||||
|
@ -228,6 +235,7 @@ let translate (p : S.t) env =
|
||||||
let rdefs =(
|
let rdefs =(
|
||||||
let rname = List.map fst rdefs in
|
let rname = List.map fst rdefs in
|
||||||
let free_vars f =
|
let free_vars f =
|
||||||
|
|
||||||
match f with
|
match f with
|
||||||
| S.Fun(id, expr) ->
|
| S.Fun(id, expr) ->
|
||||||
let new_id = id @ rname in
|
let new_id = id @ rname in
|
||||||
|
@ -236,27 +244,32 @@ let translate (p : S.t) env =
|
||||||
| _ -> failwith "Error recFunctions : This is not a function"
|
| _ -> failwith "Error recFunctions : This is not a function"
|
||||||
in
|
in
|
||||||
List.map (fun (name, expr) -> name, free_vars expr) rdefs)
|
List.map (fun (name, expr) -> name, free_vars expr) rdefs)
|
||||||
|
|
||||||
in
|
in
|
||||||
|
(* On regarde si la fonction recursive est seule, si c'est le cas, on traite
|
||||||
|
le cas simple d'une fonction anonyme seul.*)
|
||||||
match rdefs with
|
match rdefs with
|
||||||
| [name, (free_vars, arguments, expr)] ->
|
| [name, (free_vars, arguments, expr)] ->
|
||||||
let defs, expre = fonction_anonyme env free_vars arguments expr in
|
let defs, expre = fonction_anonyme env ~name free_vars arguments expr in
|
||||||
defs, [identifier name, expre]
|
defs, [identifier name, expre]
|
||||||
| _ ->
|
| _ -> (*Sinon, on créé des clotures pour chaque fonction de nos fonctions récursives*)
|
||||||
let rdefs = creation_cloture_rec rdefs in
|
let rdefs = creation_cloture_rec rdefs in
|
||||||
let fs, rdefs = List.split rdefs in
|
let fs, rdefs = List.split rdefs in
|
||||||
|
(* Puis on les traduit toute les fonctions *)
|
||||||
let trad_rdef = trad_rec_definition rdefs in
|
let trad_rdef = trad_rec_definition rdefs in
|
||||||
let fs', exprs = List.split trad_rdef in
|
let fs', exprs = List.split trad_rdef in
|
||||||
fs @ List.concat fs', exprs
|
fs @ List.concat fs', exprs
|
||||||
|
|
||||||
|
|
||||||
(*Fonction qui créé des clotures *)
|
(*Fonction qui créé des clotures pour chaque récursion *)
|
||||||
and creation_cloture_rec rdefs =
|
and creation_cloture_rec rdefs =
|
||||||
let nb = List.length rdefs -1 in
|
let nb = List.length rdefs -1 in
|
||||||
List.map (fun (name, (free_vars, x, e)) ->
|
List.map (fun (name, (free_vars, x, e)) ->
|
||||||
let new_name = make_fresh_variable () in
|
let new_name = make_fresh_variable () in
|
||||||
T.DefineValue (new_name, new_cloture nb free_vars), ((name, new_name), (free_vars, x, e))) rdefs
|
T.DefineValue (new_name, new_cloture nb free_vars), ((name, new_name), (free_vars, x, e))) rdefs
|
||||||
|
|
||||||
|
(* Fonction qui traduit chaque fonction en appel de fonction anonyme mais également
|
||||||
|
le nom en identifiant de fonction pour fopix.*)
|
||||||
and trad_rec_definition rdefs =
|
and trad_rec_definition rdefs =
|
||||||
let rname = List.map fst rdefs in
|
let rname = List.map fst rdefs in
|
||||||
List.map
|
List.map
|
||||||
|
@ -280,7 +293,6 @@ let translate (p : S.t) env =
|
||||||
in
|
in
|
||||||
[], xc
|
[], xc
|
||||||
| S.Define (vdef, a) ->
|
| S.Define (vdef, a) ->
|
||||||
(* 1.3 (2) *)
|
|
||||||
let afs, a = expression env a in
|
let afs, a = expression env a in
|
||||||
(match vdef with
|
(match vdef with
|
||||||
| S.SimpleValue (id, b) ->
|
| S.SimpleValue (id, b) ->
|
||||||
|
@ -330,6 +342,9 @@ let translate (p : S.t) env =
|
||||||
bs, Some e
|
bs, Some e
|
||||||
in
|
in
|
||||||
afs @ bsfs @ dfs, T.Switch (a, Array.of_list bs, default)
|
afs @ bsfs @ dfs, T.Switch (a, Array.of_list bs, default)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
and expressions env = function
|
and expressions env = function
|
||||||
| [] -> [], []
|
| [] -> [], []
|
||||||
| e :: es ->
|
| e :: es ->
|
||||||
|
@ -342,6 +357,8 @@ 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 *)
|
||||||
and add_liste_funcdef env fid x expr =
|
and add_liste_funcdef env fid x expr =
|
||||||
|
@ -356,10 +373,15 @@ let translate (p : S.t) env =
|
||||||
) in
|
) in
|
||||||
dfs @ [ T.DefineFunction (fid, T.Id "oldenvironment" :: x, expr) ]
|
dfs @ [ T.DefineFunction (fid, T.Id "oldenvironment" :: x, expr) ]
|
||||||
|
|
||||||
|
(*Traitement des fonctions anonymes*)
|
||||||
and fonction_anonyme ?name ?block env f x e =
|
and fonction_anonyme ?name ?block env f x e =
|
||||||
|
(*On commence par générer de nouveaux identifiants pour nos fonctions*)
|
||||||
let fname = make_fresh_function_identifier () in
|
let fname = make_fresh_function_identifier () in
|
||||||
|
(*On traduit l'id de chaque argument*)
|
||||||
let arguments_x = List.map identifier x in
|
let arguments_x = List.map identifier x in
|
||||||
|
(* On créé la cloture pour notre fonction anonyme*)
|
||||||
let cloture, env = creation_cloture env name block fname f in
|
let cloture, env = creation_cloture env name block fname f in
|
||||||
|
(*On met à jour la liste des définitions de fonctions*)
|
||||||
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
|
||||||
|
|
||||||
|
@ -370,13 +392,13 @@ let translate (p : S.t) env =
|
||||||
| Some name -> bind_var env name (T.Variable(T.Id "oldenvironment"))
|
| Some name -> bind_var env name (T.Variable(T.Id "oldenvironment"))
|
||||||
in
|
in
|
||||||
match block with
|
match block with
|
||||||
| None ->
|
| None -> (*Cas où on a une simple fonction anonyme*)
|
||||||
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 (block, rdefs) ->
|
| Some (block, rdefs) -> (*Cas pour les fonctions mutuellements récursive*)
|
||||||
add_to_cloture env fname (T.Variable block) free_vars rdefs
|
add_to_cloture env fname (T.Variable block) free_vars rdefs
|
||||||
|
|
||||||
|
|
||||||
|
|
Reference in a new issue