Etape S.Fun (ne marche surement pas)
This commit is contained in:
parent
34c2a6c8e3
commit
f7567888c9
1 changed files with 50 additions and 2 deletions
|
@ -179,6 +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 }
|
||||||
|
|
||||||
(** Precondition: [is_external id env = true]. *)
|
(** Precondition: [is_external id env = true]. *)
|
||||||
let arity_of_external id env =
|
let arity_of_external id env =
|
||||||
|
@ -245,11 +246,21 @@ let translate (p : S.t) env =
|
||||||
| 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 *)
|
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 *)
|
||||||
|
|
||||||
|
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
|
||||||
|
@ -292,6 +303,43 @@ let translate (p : S.t) env =
|
||||||
| S.LString s -> T.LString s
|
| S.LString s -> T.LString s
|
||||||
| 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 in
|
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 =
|
||||||
|
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
|
||||||
|
|
||||||
|
and new_cloture espace list_variable =
|
||||||
|
allocate_block (lint (espace + List.length list_variable + 1))
|
||||||
|
|
||||||
|
and add_to_cloture env fname env_var free_vars =
|
||||||
|
let first_block = write_block env_var (lint 0) (T.Literal (T.LFun fname)) in
|
||||||
|
let env, vars_free, k =
|
||||||
|
List.fold_left (fun(env,list,k) id ->
|
||||||
|
let new_env = bind_var env id (read_block (T.Variable (T.Id "oldenvironment")) (lint k)) in
|
||||||
|
let new_valeur =
|
||||||
|
match Dict.lookup id env.vars with
|
||||||
|
| None -> T.Variable (identifier id)
|
||||||
|
| Some v -> v in
|
||||||
|
let new_instr = write_block env_var (lint k) new_valeur in
|
||||||
|
(new_env, new_instr::list, k+1)
|
||||||
|
)
|
||||||
|
(env,[],1)
|
||||||
|
|
||||||
|
free_vars in
|
||||||
|
let instrs = List.rev (env_var::first_block::vars_free) in
|
||||||
|
seqs instrs, env
|
||||||
|
|
||||||
|
in
|
||||||
program env p
|
program env p
|
||||||
;;
|
;;
|
||||||
|
|
Reference in a new issue