Commit 637c820f authored by Francois Bobot's avatar Francois Bobot

metas become a record instead of just a string

parent 3695c1f8
...@@ -29,7 +29,7 @@ _arguments -s -S \ ...@@ -29,7 +29,7 @@ _arguments -s -S \
"(-L --library -I)"'-I'"[same as -L (obsolete)]:Mlpost lib path (obsolete use -L):_files -/ "\ "(-L --library -I)"'-I'"[same as -L (obsolete)]:Mlpost lib path (obsolete use -L):_files -/ "\
"(-D --driver -P -prover)"'-P'"[<prover> Prove or print (with -o) the selected goals]:<prover>:->provers"\ "(-D --driver -P -prover)"'-P'"[<prover> Prove or print (with -o) the selected goals]:<prover>:->provers"\
"(-D --driver -P -prover)"'--prover'"[same as -P]:<prover>:->provers"\ "(-D --driver -P -prover)"'--prover'"[same as -P]:<prover>:->provers"\
'*-M'"[<meta_name> <string> Add a meta option to each tasks]:<meta_name>:->metas:<meta_arg>:"\ '*-M'"[<meta_name>=<string> Add a meta option to each tasks]:<meta_name>=<meta_arg>:->metas"\
"(-F --format)"'-F'"[<format> Input format (default: \"why\")]:<input format>:"\ "(-F --format)"'-F'"[<format> Input format (default: \"why\")]:<input format>:"\
"(-F --format)"'--format'"[same as -F]:<input format>:"\ "(-F --format)"'--format'"[same as -F]:<input format>:"\
"(-t --timelimit)"'-t'"[<sec> Set the prover\'s time limit (default=10, no limit=0)]:<timeout s>:"\ "(-t --timelimit)"'-t'"[<sec> Set the prover\'s time limit (default=10, no limit=0)]:<timeout s>:"\
...@@ -74,7 +74,7 @@ case $state in ...@@ -74,7 +74,7 @@ case $state in
;; ;;
metas) metas)
_message "<metas>"; _message "<metas>";
METAS="$($cmd --list-metas | egrep -E "^ [a-z]" | sed "s/^[ ]*//")"; METAS="$($cmd --list-metas | egrep -E "^ [a-z]" | sed -e "s/^[ ]*//" -e "s/$/=/")";
METAS=(${(f)METAS}); METAS=(${(f)METAS});
compadd $METAS; compadd $METAS;
return 0 return 0
......
...@@ -373,9 +373,9 @@ let print_tdecl fmt td = match td.td_node with ...@@ -373,9 +373,9 @@ let print_tdecl fmt td = match td.td_node with
print_th th (print_list comma print_inst_ts) tm print_th th (print_list comma print_inst_ts) tm
(print_list comma print_inst_ls) lm (print_list comma print_inst_ls) lm
(print_list comma print_inst_pr) pm (print_list comma print_inst_pr) pm
| Meta (t,al) -> | Meta (m,al) ->
fprintf fmt "@[<hov 2>(* meta %s %a *)@]" fprintf fmt "@[<hov 2>(* meta %s %a *)@]"
t (print_list comma print_meta_arg) al (meta_name m) (print_list comma print_meta_arg) al
let print_theory fmt th = let print_theory fmt th =
fprintf fmt "@[<hov 2>theory %a@\n%a@]@\nend@." fprintf fmt "@[<hov 2>theory %a@\n%a@]@\nend@."
......
...@@ -46,9 +46,9 @@ val list_printers : unit -> string list ...@@ -46,9 +46,9 @@ val list_printers : unit -> string list
val print_prelude : prelude pp val print_prelude : prelude pp
val print_th_prelude : task -> prelude_map pp val print_th_prelude : task -> prelude_map pp
val meta_remove_type : string val meta_remove_type : meta
val meta_remove_logic : string val meta_remove_logic : meta
val meta_remove_prop : string val meta_remove_prop : meta
val remove_type : tysymbol -> tdecl val remove_type : tysymbol -> tdecl
val remove_logic : lsymbol -> tdecl val remove_logic : lsymbol -> tdecl
......
...@@ -48,18 +48,18 @@ let tds_singleton td = mk_tds (Stdecl.singleton td) ...@@ -48,18 +48,18 @@ let tds_singleton td = mk_tds (Stdecl.singleton td)
let tds_equal = (==) let tds_equal = (==)
type clone_map = tdecl_set Mid.t type clone_map = tdecl_set Mid.t
type meta_map = tdecl_set Mstr.t type meta_map = tdecl_set Mmeta.t
let cm_find cm th = try Mid.find th.th_name cm with Not_found -> empty_tds let cm_find cm th = try Mid.find th.th_name cm with Not_found -> empty_tds
let mm_find mm t = let mm_find mm t =
try Mstr.find t mm with Not_found -> ignore (lookup_meta t); empty_tds try Mmeta.find t mm with Not_found -> empty_tds
let cm_add cm th td = Mid.add th.th_name (tds_add td (cm_find cm th)) cm let cm_add cm th td = Mid.add th.th_name (tds_add td (cm_find cm th)) cm
let mm_add mm t td = if is_meta_excl t let mm_add mm t td = if is_meta_excl t
then Mstr.add t (tds_singleton td) mm then Mmeta.add t (tds_singleton td) mm
else Mstr.add t (tds_add td (mm_find mm t)) mm else Mmeta.add t (tds_add td (mm_find mm t)) mm
(** Task *) (** Task *)
...@@ -106,7 +106,7 @@ let mk_task decl prev known clone meta = Some (Hstask.hashcons { ...@@ -106,7 +106,7 @@ let mk_task decl prev known clone meta = Some (Hstask.hashcons {
let task_known = option_apply Mid.empty (fun t -> t.task_known) let task_known = option_apply Mid.empty (fun t -> t.task_known)
let task_clone = option_apply Mid.empty (fun t -> t.task_clone) let task_clone = option_apply Mid.empty (fun t -> t.task_clone)
let task_meta = option_apply Mstr.empty (fun t -> t.task_meta) let task_meta = option_apply Mmeta.empty (fun t -> t.task_meta)
let find_clone task th = cm_find (task_clone task) th let find_clone task th = cm_find (task_clone task) th
let find_meta task t = mm_find (task_meta task) t let find_meta task t = mm_find (task_meta task) t
...@@ -213,38 +213,38 @@ let task_decls = task_fold (fun acc td -> ...@@ -213,38 +213,38 @@ let task_decls = task_fold (fun acc td ->
(* special selector for metaproperties of a single ident *) (* special selector for metaproperties of a single ident *)
exception NotTaggingMeta of string exception NotTaggingMeta of meta
let find_tagged_ts t tds acc = let find_tagged_ts t tds acc =
begin match lookup_meta t with begin match meta_arg_type t with
| [MTtysymbol] -> () | [MTtysymbol] -> ()
| _ -> raise (NotTaggingMeta t) | _ -> raise (NotTaggingMeta t)
end; end;
Stdecl.fold (fun td acc -> match td.td_node with Stdecl.fold (fun td acc -> match td.td_node with
| Meta (s, [MAts ts]) when s = t -> Sts.add ts acc | Meta (s, [MAts ts]) when meta_equal s t -> Sts.add ts acc
| _ -> assert false) tds.tds_set acc | _ -> assert false) tds.tds_set acc
let find_tagged_ls t tds acc = let find_tagged_ls t tds acc =
begin match lookup_meta t with begin match meta_arg_type t with
| [MTlsymbol] -> () | [MTlsymbol] -> ()
| _ -> raise (NotTaggingMeta t) | _ -> raise (NotTaggingMeta t)
end; end;
Stdecl.fold (fun td acc -> match td.td_node with Stdecl.fold (fun td acc -> match td.td_node with
| Meta (s, [MAls ls]) when s = t -> Sls.add ls acc | Meta (s, [MAls ls]) when meta_equal s t -> Sls.add ls acc
| _ -> assert false) tds.tds_set acc | _ -> assert false) tds.tds_set acc
let find_tagged_pr t tds acc = let find_tagged_pr t tds acc =
begin match lookup_meta t with begin match meta_arg_type t with
| [MTprsymbol] -> () | [MTprsymbol] -> ()
| _ -> raise (NotTaggingMeta t) | _ -> raise (NotTaggingMeta t)
end; end;
Stdecl.fold (fun td acc -> match td.td_node with Stdecl.fold (fun td acc -> match td.td_node with
| Meta (s, [MApr pr]) when s = t -> Spr.add pr acc | Meta (s, [MApr pr]) when meta_equal s t -> Spr.add pr acc
| _ -> assert false) tds.tds_set acc | _ -> assert false) tds.tds_set acc
exception NotExclusiveMeta of string exception NotExclusiveMeta of meta
let get_meta_exc t tds = let get_meta_excl t tds =
if not (is_meta_excl t) then raise (NotExclusiveMeta t); if not (is_meta_excl t) then raise (NotExclusiveMeta t);
Stdecl.fold (fun td _ -> match td.td_node with Stdecl.fold (fun td _ -> match td.td_node with
| Meta (s,arg) when s = t -> Some arg | Meta (s,arg) when s = t -> Some arg
...@@ -257,9 +257,9 @@ let () = Exn_printer.register (fun fmt exn -> match exn with ...@@ -257,9 +257,9 @@ let () = Exn_printer.register (fun fmt exn -> match exn with
| SkipFound -> Format.fprintf fmt "Task cannot contain a skip" | SkipFound -> Format.fprintf fmt "Task cannot contain a skip"
| GoalFound -> Format.fprintf fmt "The task already ends with a goal" | GoalFound -> Format.fprintf fmt "The task already ends with a goal"
| GoalNotFound -> Format.fprintf fmt "The task does not end with a goal" | GoalNotFound -> Format.fprintf fmt "The task does not end with a goal"
| NotTaggingMeta s -> | NotTaggingMeta m ->
Format.fprintf fmt "Metaproperty '%s' is not a symbol tag" s Format.fprintf fmt "Metaproperty '%s' is not a symbol tag" (meta_name m)
| NotExclusiveMeta s -> | NotExclusiveMeta m ->
Format.fprintf fmt "Metaproperty '%s' is not exclusive" s Format.fprintf fmt "Metaproperty '%s' is not exclusive" (meta_name m)
| _ -> raise exn) | _ -> raise exn)
...@@ -34,7 +34,7 @@ type tdecl_set = private { ...@@ -34,7 +34,7 @@ type tdecl_set = private {
val tds_equal : tdecl_set -> tdecl_set -> bool val tds_equal : tdecl_set -> tdecl_set -> bool
type clone_map = tdecl_set Mid.t type clone_map = tdecl_set Mid.t
type meta_map = tdecl_set Mstr.t type meta_map = tdecl_set Mmeta.t
(** Task *) (** Task *)
...@@ -57,7 +57,7 @@ val task_clone : task -> clone_map ...@@ -57,7 +57,7 @@ val task_clone : task -> clone_map
val task_meta : task -> meta_map val task_meta : task -> meta_map
val find_clone : task -> theory -> tdecl_set val find_clone : task -> theory -> tdecl_set
val find_meta : task -> string -> tdecl_set val find_meta : task -> meta -> tdecl_set
(** {2 constructors} *) (** {2 constructors} *)
...@@ -66,7 +66,7 @@ val add_tdecl : task -> tdecl -> task ...@@ -66,7 +66,7 @@ val add_tdecl : task -> tdecl -> task
val use_export : task -> theory -> task val use_export : task -> theory -> task
val clone_export : task -> theory -> th_inst -> task val clone_export : task -> theory -> th_inst -> task
val add_meta : task -> string -> meta_arg list -> task val add_meta : task -> meta -> meta_arg list -> task
(** {2 declaration constructors + add_decl} *) (** {2 declaration constructors + add_decl} *)
...@@ -97,17 +97,17 @@ val task_goal : task -> prsymbol ...@@ -97,17 +97,17 @@ val task_goal : task -> prsymbol
(* special selector for metaproperties of a single ident *) (* special selector for metaproperties of a single ident *)
exception NotTaggingMeta of string exception NotTaggingMeta of meta
val find_tagged_ts : string -> tdecl_set -> Sts.t -> Sts.t val find_tagged_ts : meta -> tdecl_set -> Sts.t -> Sts.t
val find_tagged_ls : string -> tdecl_set -> Sls.t -> Sls.t val find_tagged_ls : meta -> tdecl_set -> Sls.t -> Sls.t
val find_tagged_pr : string -> tdecl_set -> Spr.t -> Spr.t val find_tagged_pr : meta -> tdecl_set -> Spr.t -> Spr.t
(* special selector for exclusive metaproperties *) (* special selector for exclusive metaproperties *)
exception NotExclusiveMeta of string exception NotExclusiveMeta of meta
val get_meta_exc : string -> tdecl_set -> meta_arg list option val get_meta_excl : meta -> tdecl_set -> meta_arg list option
(* exceptions *) (* exceptions *)
......
...@@ -96,32 +96,57 @@ type meta_arg = ...@@ -96,32 +96,57 @@ type meta_arg =
| MAstr of string | MAstr of string
| MAint of int | MAint of int
exception KnownMeta of string type meta = {
meta_tag : int;
meta_name : string;
meta_arg_type : meta_arg_type list;
meta_excl : bool;
}
module SMmeta = StructMake(struct type t = meta let tag m = m.meta_tag end)
module Smeta = SMmeta.S
module Mmeta = SMmeta.M
module Hmeta = SMmeta.H
let meta_equal m1 m2 = m1.meta_tag = m2.meta_tag
exception KnownMeta of meta
exception UnknownMeta of string exception UnknownMeta of string
exception BadMetaArity of string * int * int exception BadMetaArity of meta * int * int
exception MetaTypeMismatch of string * meta_arg_type * meta_arg_type exception MetaTypeMismatch of meta * meta_arg_type * meta_arg_type
let meta_tag = let c = ref (-1) in
fun () -> incr c; !c
let meta_table = Hashtbl.create 17 let meta_table = Hashtbl.create 17
let meta_excl = Hashtbl.create 17
let register_meta s al = let register_meta s al excl =
begin try try
let al' = Hashtbl.find meta_table s in let al' = Hashtbl.find meta_table s in
if al <> al' then raise (KnownMeta s) if al <> al'.meta_arg_type ||
with Not_found -> Hashtbl.add meta_table s al end; excl <> al'.meta_excl
s then raise (KnownMeta al')
else al'
let register_meta_excl s al = with Not_found ->
Hashtbl.add meta_excl s (); let meta = { meta_tag = meta_tag ();
register_meta s al meta_arg_type = al;
meta_name = s;
meta_excl = excl} in
Hashtbl.add meta_table s meta;
meta
let register_meta_excl s al = register_meta s al true
let register_meta s al = register_meta s al false
let lookup_meta s = let lookup_meta s =
try Hashtbl.find meta_table s try Hashtbl.find meta_table s
with Not_found -> raise (UnknownMeta s) with Not_found -> raise (UnknownMeta s)
let is_meta_excl s = Hashtbl.mem meta_excl s let is_meta_excl m = m.meta_excl
let meta_arg_type m = m.meta_arg_type
let meta_name m = m.meta_name
let list_metas () = Hashtbl.fold (fun k v acc -> (k,v)::acc) meta_table [] let list_metas () = Hashtbl.fold (fun _ v acc -> v::acc) meta_table []
(** Theory *) (** Theory *)
...@@ -144,7 +169,7 @@ and tdecl_node = ...@@ -144,7 +169,7 @@ and tdecl_node =
| Decl of decl | Decl of decl
| Use of theory | Use of theory
| Clone of theory * tysymbol Mts.t * lsymbol Mls.t * prsymbol Mpr.t | Clone of theory * tysymbol Mts.t * lsymbol Mls.t * prsymbol Mpr.t
| Meta of string * meta_arg list | Meta of meta * meta_arg list
(** Theory declarations *) (** Theory declarations *)
...@@ -640,19 +665,16 @@ let get_meta_arg_type = function ...@@ -640,19 +665,16 @@ let get_meta_arg_type = function
| MAstr _ -> MTstring | MAstr _ -> MTstring
| MAint _ -> MTint | MAint _ -> MTint
let create_meta s al = let create_meta m al =
let atl = try Hashtbl.find meta_table s
with Not_found -> raise (UnknownMeta s)
in
let get_meta_arg at a = let get_meta_arg at a =
let mt = get_meta_arg_type a in let mt = get_meta_arg_type a in
if at = mt then a else raise (MetaTypeMismatch (s,at,mt)) if at = mt then a else raise (MetaTypeMismatch (m,at,mt))
in in
let al = try List.map2 get_meta_arg atl al let al = try List.map2 get_meta_arg m.meta_arg_type al
with Invalid_argument _ -> with Invalid_argument _ ->
raise (BadMetaArity (s, List.length atl, List.length al)) raise (BadMetaArity (m, List.length m.meta_arg_type, List.length al))
in in
mk_tdecl (Meta (s,al)) mk_tdecl (Meta (m,al))
let add_meta uc s al = add_tdecl uc (create_meta s al) let add_meta uc s al = add_tdecl uc (create_meta s al)
...@@ -715,15 +737,16 @@ let () = Exn_printer.register ...@@ -715,15 +737,16 @@ let () = Exn_printer.register
Format.fprintf fmt "Symbol %s is already defined in the current scope" s Format.fprintf fmt "Symbol %s is already defined in the current scope" s
| UnknownMeta s -> | UnknownMeta s ->
Format.fprintf fmt "Unknown metaproperty %s" s Format.fprintf fmt "Unknown metaproperty %s" s
| KnownMeta s -> | KnownMeta m ->
Format.fprintf fmt "Metaproperty %s is already registered with \ Format.fprintf fmt "Metaproperty %s is already registered with \
a conflicting signature" s a conflicting signature" m.meta_name
| BadMetaArity (s,i1,i2) -> | BadMetaArity (m,i1,i2) ->
Format.fprintf fmt "Metaproperty %s requires %d arguments but \ Format.fprintf fmt "Metaproperty %s requires %d arguments but \
is applied to %d" s i1 i2 is applied to %d" m.meta_name i1 i2
| MetaTypeMismatch (s,t1,t2) -> | MetaTypeMismatch (m,t1,t2) ->
Format.fprintf fmt "Metaproperty %s expects %a argument but \ Format.fprintf fmt "Metaproperty %s expects %a argument but \
is applied to %a" s print_meta_arg_type t1 print_meta_arg_type t2 is applied to %a"
m.meta_name print_meta_arg_type t1 print_meta_arg_type t2
| _ -> raise exn | _ -> raise exn
end end
...@@ -54,13 +54,23 @@ type meta_arg = ...@@ -54,13 +54,23 @@ type meta_arg =
| MAstr of string | MAstr of string
| MAint of int | MAint of int
val register_meta : string -> meta_arg_type list -> string type meta
val register_meta_excl : string -> meta_arg_type list -> string
val lookup_meta : string -> meta_arg_type list module Smeta : Set.S with type elt = meta
val is_meta_excl : string -> bool module Mmeta : Map.S with type key = meta
module Hmeta : Hashtbl.S with type key = meta
val list_metas : unit -> (string * meta_arg_type list) list val meta_equal : meta -> meta -> bool
val register_meta : string -> meta_arg_type list -> meta
val register_meta_excl : string -> meta_arg_type list -> meta
val lookup_meta : string -> meta
val meta_name : meta -> string
val meta_arg_type : meta -> meta_arg_type list
val is_meta_excl : meta -> bool
val list_metas : unit -> meta list
(** Theory *) (** Theory *)
...@@ -82,7 +92,7 @@ and tdecl_node = private ...@@ -82,7 +92,7 @@ and tdecl_node = private
| Decl of decl | Decl of decl
| Use of theory | Use of theory
| Clone of theory * tysymbol Mts.t * lsymbol Mls.t * prsymbol Mpr.t | Clone of theory * tysymbol Mts.t * lsymbol Mls.t * prsymbol Mpr.t
| Meta of string * meta_arg list | Meta of meta * meta_arg list
module Stdecl : Set.S with type elt = tdecl module Stdecl : Set.S with type elt = tdecl
module Mtdecl : Map.S with type key = tdecl module Mtdecl : Map.S with type key = tdecl
...@@ -152,9 +162,9 @@ val create_null_clone : theory -> tdecl ...@@ -152,9 +162,9 @@ val create_null_clone : theory -> tdecl
(** Meta *) (** Meta *)
val create_meta : string -> meta_arg list -> tdecl val create_meta : meta -> meta_arg list -> tdecl
val add_meta : theory_uc -> string -> meta_arg list -> theory_uc val add_meta : theory_uc -> meta -> meta_arg list -> theory_uc
val clone_meta : tdecl -> theory -> tdecl -> tdecl val clone_meta : tdecl -> theory -> tdecl -> tdecl
(* [clone_meta td_meta th td_clone] produces from [td_meta] (* [clone_meta td_meta th td_clone] produces from [td_meta]
...@@ -177,8 +187,8 @@ exception CloseTheory ...@@ -177,8 +187,8 @@ exception CloseTheory
exception NoOpenedNamespace exception NoOpenedNamespace
exception ClashSymbol of string exception ClashSymbol of string
exception KnownMeta of string exception KnownMeta of meta
exception UnknownMeta of string exception UnknownMeta of string
exception BadMetaArity of string * int * int exception BadMetaArity of meta * int * int
exception MetaTypeMismatch of string * meta_arg_type * meta_arg_type exception MetaTypeMismatch of meta * meta_arg_type * meta_arg_type
...@@ -54,7 +54,8 @@ let fold fn v = ...@@ -54,7 +54,8 @@ let fold fn v =
let rewind acc task = let rewind acc task =
(* (*
Format.printf "%c%d." (match task.task_decl.td_node with Format.printf "%c%d." (match task.task_decl.td_node with
Decl _ -> 'D' | Clone _ -> 'C' | Use _ -> 'U' | Meta _ -> 'M') task.task_tag; Decl _ -> 'D' | Clone _ -> 'C'
| Use _ -> 'U' | Meta _ -> 'M') task.task_tag;
*) *)
let acc = fn task acc in let acc = fn task acc in
WHtask.set h task acc; WHtask.set h task acc;
...@@ -164,10 +165,10 @@ let on_theories tl fn = ...@@ -164,10 +165,10 @@ let on_theories tl fn =
let on_metas tl fn = let on_metas tl fn =
let rec pass acc = function let rec pass acc = function
| t::tl -> on_meta t (fun st -> pass (Mstr.add t st acc) tl) | t::tl -> on_meta t (fun st -> pass (Mmeta.add t st acc) tl)
| [] -> fn acc | [] -> fn acc
in in
pass Mstr.empty tl pass Mmeta.empty tl
let on_theories_metas thl tl fn = let on_theories_metas thl tl fn =
on_theories thl (fun cm -> on_metas tl (fn cm)) on_theories thl (fun cm -> on_metas tl (fn cm))
......
...@@ -70,12 +70,12 @@ val rewrite : (term -> term) -> (fmla -> fmla) -> task -> task trans ...@@ -70,12 +70,12 @@ val rewrite : (term -> term) -> (fmla -> fmla) -> task -> task trans
(* dependent transformatons *) (* dependent transformatons *)
val on_theory : theory -> (tdecl_set -> 'a trans) -> 'a trans val on_theory : theory -> (tdecl_set -> 'a trans) -> 'a trans
val on_meta : string -> (tdecl_set -> 'a trans) -> 'a trans val on_meta : meta -> (tdecl_set -> 'a trans) -> 'a trans
val on_theories : theory list -> (clone_map -> 'a trans) -> 'a trans val on_theories : theory list -> (clone_map -> 'a trans) -> 'a trans
val on_metas : string list -> (meta_map -> 'a trans) -> 'a trans val on_metas : meta list -> (meta_map -> 'a trans) -> 'a trans
val on_theories_metas : theory list -> string list -> val on_theories_metas : theory list -> meta list ->
(clone_map -> meta_map -> 'a trans) -> 'a trans (clone_map -> meta_map -> 'a trans) -> 'a trans
(** {2 Registration} *) (** {2 Registration} *)
......
...@@ -144,7 +144,8 @@ let load_driver = let driver_tag = ref (-1) in fun env file -> ...@@ -144,7 +144,8 @@ let load_driver = let driver_tag = ref (-1) in fun env file ->
| PMAstr s -> MAstr s | PMAstr s -> MAstr s
| PMAint i -> MAint i | PMAint i -> MAint i
in in
let td = create_meta s (List.map convert al) in let m = lookup_meta s in
let td = create_meta m (List.map convert al) in
add_meta th td (if c then meta_cl else meta) add_meta th td (if c then meta_cl else meta)
in in
let add_local th (loc,rule) = let add_local th (loc,rule) =
......
...@@ -78,7 +78,11 @@ let add_opt_goal x = match !opt_theory with ...@@ -78,7 +78,11 @@ let add_opt_goal x = match !opt_theory with
let add_opt_trans x = opt_trans := x::!opt_trans let add_opt_trans x = opt_trans := x::!opt_trans
let add_opt_meta meta_name meta_arg = let add_opt_meta meta =
let meta_name, meta_arg =
let index = String.index meta '=' in
(String.sub meta 0 index),
(String.sub meta (index+1) (String.length meta - (index + 1))) in
opt_metas := (meta_name,meta_arg)::!opt_metas opt_metas := (meta_name,meta_arg)::!opt_metas
let opt_config = ref None let opt_config = ref None
...@@ -141,11 +145,8 @@ let option_list = Arg.align [ ...@@ -141,11 +145,8 @@ let option_list = Arg.align [
"<MiB> Set the prover's memory limit (default: no limit)"; "<MiB> Set the prover's memory limit (default: no limit)";
"--memlimit", Arg.Int (fun i -> opt_timelimit := Some i), "--memlimit", Arg.Int (fun i -> opt_timelimit := Some i),
" same as -m"; " same as -m";
"-M", "-M", Arg.String add_opt_meta,
begin let meta_opt = ref "" in "<meta_name>=<string> Add a meta option to each tasks";
Arg.Tuple ([Arg.Set_string meta_opt;
Arg.String (fun s -> add_opt_meta !meta_opt s)]) end,
"<meta_name>,<string> Add a meta option to each tasks";
"-D", Arg.String (fun s -> opt_driver := Some s), "-D", Arg.String (fun s -> opt_driver := Some s),
"<file> Specify a prover's driver (conflicts with -P)"; "<file> Specify a prover's driver (conflicts with -P)";
"--driver", Arg.String (fun s -> opt_driver := Some s), "--driver", Arg.String (fun s -> opt_driver := Some s),
...@@ -214,15 +215,15 @@ let () = ...@@ -214,15 +215,15 @@ let () =
end; end;
if !opt_list_metas then begin if !opt_list_metas then begin
let metas = list_metas () in let metas = list_metas () in
let filter (s,args) = let fold acc m =
match args with match meta_arg_type m with
| [MTstring] -> is_meta_excl s | [MTstring] when is_meta_excl m -> Smeta.add m acc
| _ -> false in | _ -> acc in
let metas = List.filter filter metas in let metas