Commit 1e107236 authored by Francois Bobot's avatar Francois Bobot

output-dir : Le nom du but n'est plus inutilement modifie lors de la génération du nom de fichier

parent 1f04cb60
...@@ -117,6 +117,9 @@ let id_unique (indices,values,san0) ?(sanitizer = same) id = ...@@ -117,6 +117,9 @@ let id_unique (indices,values,san0) ?(sanitizer = same) id =
Hashtbl.replace values id.id_tag name; Hashtbl.replace values id.id_tag name;
name name
let string_unique printer s =
id_unique printer (id_register (id_fresh s))
let forget_id (indices,values,_) id = let forget_id (indices,values,_) id =
try try
let name = Hashtbl.find values id.id_tag in let name = Hashtbl.find values id.id_tag in
......
...@@ -78,6 +78,9 @@ val create_ident_printer : ...@@ -78,6 +78,9 @@ val create_ident_printer :
val id_unique : val id_unique :
ident_printer -> ?sanitizer : (string -> string) -> ident -> string ident_printer -> ?sanitizer : (string -> string) -> ident -> string
(* Uniquify string *)
val string_unique : ident_printer -> string -> string
(* forget an ident *) (* forget an ident *)
val forget_id : ident_printer -> ident -> unit val forget_id : ident_printer -> ident -> unit
......
...@@ -395,7 +395,7 @@ let print_task drv fmt task = match drv.drv_raw.drv_printer with ...@@ -395,7 +395,7 @@ let print_task drv fmt task = match drv.drv_raw.drv_printer with
let regexp_filename = Str.regexp "%\\([a-z]\\)" let regexp_filename = Str.regexp "%\\([a-z]\\)"
let filename_of_goal drv ident_printer filename theory_name task = let filename_of_goal drv filename theory_name task =
match drv.drv_raw.drv_filename with match drv.drv_raw.drv_filename with
| None -> errorm "no filename syntax given" | None -> errorm "no filename syntax given"
| Some f -> | Some f ->
...@@ -405,7 +405,7 @@ let filename_of_goal drv ident_printer filename theory_name task = ...@@ -405,7 +405,7 @@ let filename_of_goal drv ident_printer filename theory_name task =
match i with match i with
| "f" -> filename | "f" -> filename
| "t" -> theory_name | "t" -> theory_name
| "s" -> id_unique ident_printer pr_name | "s" -> pr_name.id_short
| _ -> errorm "substitution variable are only %%f %%t and %%s" in | _ -> errorm "substitution variable are only %%f %%t and %%s" in
global_substitute regexp_filename repl_fun f global_substitute regexp_filename repl_fun f
...@@ -423,7 +423,7 @@ let call_prover ?debug ?timeout drv task = ...@@ -423,7 +423,7 @@ let call_prover ?debug ?timeout drv task =
let filename = let filename =
match drv.drv_raw.drv_filename with match drv.drv_raw.drv_filename with
| None -> None | None -> None
| Some _ -> Some (filename_of_goal drv file_printer "" "" task) in | Some _ -> Some (filename_of_goal drv "why" "call_prover" task) in
let formatter fmt = print_task drv fmt task in let formatter fmt = print_task drv fmt task in
call_prover_on_formatter ?debug ?timeout ?filename drv formatter call_prover_on_formatter ?debug ?timeout ?filename drv formatter
......
...@@ -66,9 +66,8 @@ val apply_transforms : driver -> task -> task list ...@@ -66,9 +66,8 @@ val apply_transforms : driver -> task -> task list
(** print_task *) (** print_task *)
val print_task : printer val print_task : printer
val filename_of_goal : driver -> Ident.ident_printer -> val filename_of_goal : driver -> string -> string -> task -> string
string -> string -> task -> string (* filename_of_goal filename theory_name ctxt *)
(* filename_of_goal printer file_ident theory_ident ctxt *)
type prover_answer = type prover_answer =
Call_provers.prover_answer = Call_provers.prover_answer =
......
...@@ -199,7 +199,7 @@ let print_theory_namespace fmt th = ...@@ -199,7 +199,7 @@ let print_theory_namespace fmt th =
let module P = Prtree.Make(T) in let module P = Prtree.Make(T) in
P.print fmt (T.Namespace (th.th_name.Ident.id_short, th.th_export)) P.print fmt (T.Namespace (th.th_name.Ident.id_short, th.th_export))
let do_file env drv filename_printer file = let do_file env drv src_filename_printer dest_filename_printer file =
if !parse_only then begin if !parse_only then begin
let filename,c = if file = "-" let filename,c = if file = "-"
then "stdin",stdin then "stdin",stdin
...@@ -266,21 +266,22 @@ let do_file env drv filename_printer file = ...@@ -266,21 +266,22 @@ let do_file env drv filename_printer file =
try try
Filename.chop_extension file Filename.chop_extension file
with Invalid_argument _ -> file in with Invalid_argument _ -> file in
Ident.id_unique filename_printer Ident.string_unique src_filename_printer file in
(Ident.id_register (Ident.id_fresh file)) in
let ident_printer = Ident.create_ident_printer
~sanitizer:file_sanitizer [] in
List.iter List.iter
(fun (th,task,drv) -> (fun (th,task,drv) ->
let cout = let dest =
if dir = "-" Driver.filename_of_goal drv
then stdout file th.th_name.Ident.id_short task in
else (* Uniquify the filename before the extension if it exists*)
let filename = let i =
Driver.filename_of_goal drv ident_printer try String.rindex dest '.'
file th.th_name.Ident.id_short task in with Not_found -> String.length dest in
let filename = Filename.concat dir filename in let name,ext = String.sub dest 0 i,
open_out filename in String.sub dest i (String.length dest- i) in
let name = Ident.string_unique dest_filename_printer name in
let filename = name^ext in
let filename = Filename.concat dir filename in
let cout = open_out filename in
let fmt = formatter_of_out_channel cout in let fmt = formatter_of_out_channel cout in
fprintf fmt "%a@?" (Driver.print_task drv) task; fprintf fmt "%a@?" (Driver.print_task drv) task;
close_out cout) goals close_out cout) goals
...@@ -327,9 +328,12 @@ let () = ...@@ -327,9 +328,12 @@ let () =
(Pp.print_list Pp.newline Pp.string) (Driver.list_transforms ()); (Pp.print_list Pp.newline Pp.string) (Driver.list_transforms ());
exit 0 exit 0
end; end;
let filename_printer = Ident.create_ident_printer let src_filename_printer = Ident.create_ident_printer
~sanitizer:file_sanitizer [] in ~sanitizer:file_sanitizer [] in
Queue.iter (do_file env drv filename_printer) files let dest_filename_printer = Ident.create_ident_printer
~sanitizer:file_sanitizer [] in
Queue.iter (do_file env drv src_filename_printer dest_filename_printer)
files
with e when not !debug -> with e when not !debug ->
eprintf "%a@." report e; eprintf "%a@." report e;
exit 1 exit 1
......
theory Abs
type t
logic ge(t,t)
logic neg(t) : t
logic zero : t
logic abs(t) : t
axiom Pos: forall x:t. ge(x,zero) -> abs(x) = x
axiom Neg: forall x:t. not ge(x,zero) -> abs(x) = neg(x)
(*
logic abs(x : t) : t
axiom Abs_def : if ge(x,zero) then abs(x)=x else abs(x)=neg(x)
*)
end
theory MinMax
type t
logic ge(t,t)
logic min(tty,t) : t
logic max(t,t) : t
axiom Max_is_ge : forall x,y:t. ge(max(x,y),x) and ge(max(x,y),y)
axiom Max_is_some : forall x,y:t. max(x,y) = x or max(x,y) = y
axiom Min_is_le : forall x,y:t. ge(x,min(x,y)) and ge(y,min(x,y))
axiom Min_is_some : forall x,y:t. min(x,y) = x or min(x,y) = y
(*
axiom Max_x : forall x,y:t. ge(x,y) -> max(x,y) = x
axiom Max_y : forall x,y:t. ge(y,x) -> max(x,y) = y
axiom Min_y : forall x,y:t. ge(x,y) -> min(x,y) = y
axiom Min_x : forall x,y:t. ge(y,x) -> min(x,y) = x
*)
(*
logic min(x:t,y:t) : t
axiom Min_def : if ge(x,y) then min(x,y)=y else min(x,y)=x
logic max(x:t,y:t) : t
axiom Max_def : if ge(x,y) then max(x,y)=x else max(x,y)=y
*)
end
...@@ -9,7 +9,7 @@ theory Prelude ...@@ -9,7 +9,7 @@ theory Prelude
logic ref ('a) : 'a ref logic ref ('a) : 'a ref
logic (!_)('a ref) : 'a logic (!_)('a ref) : 'a
type unit use export unit.Unit
logic ignore('a) : unit logic ignore('a) : unit
type label type label
......
theory Unit
type unit = Unit
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