Commit 32f90012 authored by Jean-Christophe's avatar Jean-Christophe

programs: debugging in progress

parent 3ce8ffb1
X refs -> mutable types o what about pervasives old, at, label, unit = ()
X loadpath: how to retrieve program files? (cannot use "env")
o what about pervasives old, at, label, unit = (), lt_nat
in particular, how to prevent old and at from being used in programs? in particular, how to prevent old and at from being used in programs?
can we get rid of theories/programs.why?
o fmla_effect o fmla_effect
o bench/programs/good/recfun: FIXME o bench/programs/good/recfun: FIXME
o global reference o fixed precedence of label (label L: e) wrt sequence (e ; e)
o vacid_0_spare_array: typing bug with create o misfix _[_] and _[_] := _ for arrays (both in logic and programs)
o fixed precedence of label (label L: e) wrt sequence (e ; e)
o misfix _[_] and _[_] := _
open Format
val print_expr : Format.formatter -> Pgm_ttree.expr -> unit val print_pv : formatter -> Pgm_types.T.pvsymbol -> unit
val print_recfun : Format.formatter -> Pgm_ttree.recfun -> unit val print_expr : formatter -> Pgm_ttree.expr -> unit
val print_recfun : formatter -> Pgm_ttree.recfun -> unit
...@@ -361,10 +361,19 @@ end = struct ...@@ -361,10 +361,19 @@ end = struct
let rec eq_type_v v1 v2 = match v1, v2 with let rec eq_type_v v1 v2 = match v1, v2 with
| Tpure ty1, Tpure ty2 -> | Tpure ty1, Tpure ty2 ->
ty_equal ty1 ty2 ty_equal ty1 ty2
| Tarrow _, Tarrow _ -> | Tarrow (bl1, c1), Tarrow (bl2, c2) ->
false (* TODO? *) assert (List.length bl1 = List.length bl2); (* FIXME? *)
let s =
List.fold_left2 (fun s v1 v2 -> Mpv.add v1 (R.Rlocal v2) s)
Mpv.empty bl1 bl2
in
eq_type_c (subst_type_c s Mtv.empty Mvs.empty c1) c2
| _ -> | _ ->
assert false false
and eq_type_c c1 c2 =
eq_type_v c1.c_result_type c2.c_result_type &&
E.equal c1.c_effect c2.c_effect
(* pretty-printers *) (* pretty-printers *)
......
...@@ -962,7 +962,9 @@ let rec print_iexpr fmt e = match e.iexpr_desc with ...@@ -962,7 +962,9 @@ let rec print_iexpr fmt e = match e.iexpr_desc with
| IElet (v, e1, e2) -> | IElet (v, e1, e2) ->
fprintf fmt "@[let %a = %a in@ %a@]" print_vs v.i_pgm fprintf fmt "@[let %a = %a in@ %a@]" print_vs v.i_pgm
print_iexpr e1 print_iexpr e2 print_iexpr e1 print_iexpr e2
| IEif (e1, e2, e3) ->
fprintf fmt "@[if %a then %a else %a@]"
print_iexpr e1 print_iexpr e2 print_iexpr e3
| _ -> | _ ->
fprintf fmt "<other>" fprintf fmt "<other>"
...@@ -1360,10 +1362,15 @@ and letrec gl env dl = (* : env * recfun list *) ...@@ -1360,10 +1362,15 @@ and letrec gl env dl = (* : env * recfun list *)
map_fold_left type1 Mvs.empty dl map_fold_left type1 Mvs.empty dl
in in
let rec fixpoint m = let rec fixpoint m =
(* printf "fixpoint...@\n"; *) (* printf "fixpoint...@\n"; *)
let m', dl' = one_step m in let m', dl' = one_step m in
let same_effect (i,_,_,_,_) = let same_effect (i,bl,_,_,_) =
E.equal (Mvs.find i.i_pgm m).c_effect (Mvs.find i.i_pgm m').c_effect let c = Mvs.find i.i_pgm m and c' = Mvs.find i.i_pgm m' in
let v = tarrow bl c and v' = tarrow bl c' in
(* printf " v = %a@." print_type_v v; *)
(* printf " v'= %a@." print_type_v v'; *)
eq_type_v v v'
(* E.equal c.c_effect c'.c_effect *)
in in
if List.for_all same_effect dl then m, dl' else fixpoint m' if List.for_all same_effect dl then m, dl' else fixpoint m'
in in
......
...@@ -4,8 +4,9 @@ module P ...@@ -4,8 +4,9 @@ module P
use import int.Int use import int.Int
use import module stdlib.Ref use import module stdlib.Ref
let rec f5 (a b : ref int) = let f1 () (a : ref int) = !a
if True then !b else f5 a b
let f2 (a : ref int) = f1 () a
end end
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment