X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=ocaml%2Flambda4.ml;h=340b955049e3cc64230cb81bf258663fcdfe941b;hb=cb289306640a1605bd22b539a80710175b763810;hp=721f8225411c5ff5fb3d962d5af1df84729f08a7;hpb=5d7387369fe31267d6d414395d7dde2c32a265b0;p=fireball-separation.git diff --git a/ocaml/lambda4.ml b/ocaml/lambda4.ml index 721f822..340b955 100644 --- a/ocaml/lambda4.ml +++ b/ocaml/lambda4.ml @@ -11,7 +11,10 @@ let bomb = ref(`Var(-1,-666));; For Scott's encoding, two. *) let num_more_args = 2;; +(* verbosity *) let _very_verbose = false;; +(** Display measure of every term when printing problem *) +let _measure_of_terms = false;; let verbose s = if _very_verbose then prerr_endline s @@ -77,6 +80,7 @@ let problem_measure p = sum_arities p;; let string_of_measure = string_of_int;; let string_of_problem label ({freshno; div; conv; ps; deltas} as p) = + let aux_measure_terms t = if _measure_of_terms then "(" ^ string_of_int (measure_of_term t) ^ ") " else "" in let deltas = String.concat ("\n# ") (List.map (fun r -> String.concat " <> " (List.map (fun (i,_) -> string_of_int i) !r)) deltas) in let l = p.var_names in String.concat "\n" ([ @@ -88,10 +92,10 @@ let string_of_problem label ({freshno; div; conv; ps; deltas} as p) = ) else "# "; "#"; "$" ^ p.label; - (match div with None -> "# no D" | Some div -> "D ("^string_of_int (measure_of_term div)^")"^ print ~l (div :> nf)); + (match div with None -> "# D" | Some div -> "D " ^ aux_measure_terms div ^ print ~l (div :> nf)); ] - @ List.map (fun t -> if t = convergent_dummy then "#C" else "C ("^string_of_int (measure_of_term t)^") " ^ print ~l (t :> nf)) conv - @ List.mapi (fun i t -> string_of_int i ^ " ("^string_of_int (measure_of_term t)^") " ^ print ~l (t :> nf)) ps + @ List.map (fun t -> if t = convergent_dummy then "# C" else "C " ^ aux_measure_terms t ^ print ~l (t :> nf)) conv + @ List.mapi (fun i t -> string_of_int i ^ " " ^ aux_measure_terms t ^ print ~l (t :> nf)) ps @ [""]) ;; @@ -510,7 +514,16 @@ let compute_special_k tms = List.fold_left max 0 (List.map (aux 0) ((t :> nf)::args@List.map snd !bs)) | `N _ | `Var _ -> 0 - ) in Listx.max (Listx.map (aux 0) tms) + ) in + let rec aux' top t = match t with + | `Lam(_,t) -> aux' false t + | `I((_,ar), tms) -> max ar + (Listx.max (Listx.map (aux' false) (tms :> nf Listx.listx))) + | `Match(t, _, liftno, bs, args) -> + List.fold_left max 0 (List.map (aux' false) ((t :> nf)::(args :> nf list)@List.map snd !bs)) + | `N _ + | `Var _ -> 0 in + Listx.max (Listx.map (aux 0) tms) + Listx.max (Listx.map (aux' true) tms) ;; let auto_instantiate (n,p) =