Attention une mise à jour du service Gitlab va être effectuée le mardi 30 novembre entre 17h30 et 18h00. Cette mise à jour va générer une interruption du service dont nous ne maîtrisons pas complètement la durée mais qui ne devrait pas excéder quelques minutes. Cette mise à jour intermédiaire en version 14.0.12 nous permettra de rapidement pouvoir mettre à votre disposition une version plus récente.

Commit 8b4da539 by Jean-Christophe Filliâtre

### programs: fixed bug in variants for mutual recursive functions; new test

parent 44f9a679
 { use import int.EuclideanDivision logic even (x : int) = x = 2 * (div x 2) logic odd (x : int) = x = 2 * (div x 2) + 1 } let rec is_even x : bool variant {x} = { 0 <= x } if x = 0 then True else is_odd (x-1) { result=True <-> even x } and is_odd x : bool variant {x} = { 0 <= x } if x = 0 then False else is_even (x-1) { result=True <-> odd x } (* Local Variables: compile-command: "unset LANG; make -C ../../.. bench/programs/good/mutual" End: *)
 ../programs/good/mutual.mlw \ No newline at end of file
 ... ... @@ -1007,12 +1007,12 @@ and triple gl env (p, e, q) = and letrec gl env dl = (* : env * recfun list *) (* effects are computed as a least fixpoint [efm] maps each function to its current effect *) let make_env ~decvar m = [m] maps each function to its current effect *) let make_env ?decvar m = let add1 env (v, bl, var, _) = let c = Mvs.find v m in let c = match decvar, var with | true, Some (phi0, phi, r) -> | Some phi0, Some (_, phi, r) -> let decphi = f_app r [phi; t_var phi0] in { c with c_pre = f_and decphi c.c_pre } | _ -> ... ... @@ -1022,9 +1022,10 @@ and letrec gl env dl = (* : env * recfun list *) in List.fold_left add1 env dl in let one_step m = let env = make_env ~decvar:true m in let one_step m0 = let type1 m (v, bl, var, t) = let decvar = match var with Some (v, _, _) -> Some v | None -> None in let env = make_env ?decvar m0 in let env = add_binders env bl in let t, c = triple gl env t in Mvs.add v c m, (v, bl, var, t) ... ... @@ -1048,7 +1049,46 @@ and letrec gl env dl = (* : env * recfun list *) in let m0 = List.fold_left add_empty_effect Mvs.empty dl in let m, dl = fixpoint m0 in make_env ~decvar:false m, dl make_env m, dl (* pretty-printing (for debugging) *) let rec print_expr fmt e = match e.expr_desc with | Elogic t -> print_term fmt t | Elocal vs -> fprintf fmt "" print_vs vs | Eglobal ls -> fprintf fmt "" print_ls ls | Efun (_, t) -> fprintf fmt "@[fun _ ->@ %a@]" print_triple t | Elet (v, e1, e2) -> fprintf fmt "@[let %a = %a in@ %a@]" print_vs v print_expr e1 print_expr e2 | Esequence (e1, e2) -> fprintf fmt "@[%a;@\n%a@]" print_expr e1 print_expr e2 | Eif (e1, e2, e3) -> fprintf fmt "@[if %a@ then@ %a else@ %a@]" print_expr e1 print_expr e2 print_expr e3 | Eany c -> fprintf fmt "@[[any %a]@]" print_type_c c | _ -> fprintf fmt "" and print_triple fmt (p, e, q) = fprintf fmt "@[{%a}@ %a@ {%a}@]" print_pre p print_expr e print_post q and print_pre fmt _ = fprintf fmt "
"

and print_post fmt _ =
fprintf fmt ""

and print_recfun fmt (v, _bl, _, t) =
fprintf fmt "@[rec %a _ = %a@]" print_vs v print_triple t

(* typing declarations (combines the three phases together) *)

...  ...  @@ -1092,8 +1132,9 @@ let decl env gl = function
gl, []
| Pgm_ptree.Dlet (id, e) ->
let e = type_expr gl e in
(* if !debug then *)
(*   eprintf "@[--typing %s-----@\n  %a@]@." id.id print_expr e; *)
if !debug then
eprintf "@[--typing %s-----@\n  %a@\n%a@]@."
id.id print_expr e print_type_v e.expr_type_v;
let ls, gl = add_global id.id_loc id.id e.expr_type_v gl in
gl, [Dlet (ls, e)]
| Pgm_ptree.Dletrec dl ->
...  ...  @@ -1105,6 +1146,9 @@ let decl env gl = function
let tyv = Mvs.find v env in
let loc = loc_of_id v.vs_name in
let id = v.vs_name.id_string in
if !debug then
eprintf "@[--typing %s-----@\n  %a@.%a@]@."
id print_recfun d print_type_v tyv;
let ls, gl = add_global loc id tyv gl in
gl, (ls, d)
in
...  ...
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!