ajout def_rec en théorie mais ça ne marche pas
This commit is contained in:
parent
86e8cead3a
commit
68eec09b05
1 changed files with 81 additions and 19 deletions
|
@ -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 *)
|
||||||
|
|
Reference in a new issue