Skip to content

GitLab

why3
why3
Commit 017deebd authored by Andrei Paskevich's avatar Andrei Paskevich
Browse files
Options

keep real symbols in Clone and Meta

parent 7209c060
Hide whitespace changes
Inline Side-by-side
Showing with 197 additions and 202 deletions
src/core/decl.ml
View file @ 017deebd
......@@ -86,7 +86,7 @@ module Spr = Prop.S
module Mpr = Prop.M
module Hpr = Prop.H
let pr_equal pr1 pr2 = id_equal pr1.pr_name pr2.pr_name
let pr_equal = (==)
let create_prsymbol n = { pr_name = id_register n }
......
src/core/pretty.ml
View file @ 017deebd
......@@ -43,18 +43,11 @@ let iprinter,tprinter,lprinter,pprinter =
create_ident_printer bl ~sanitizer:isanitize,
create_ident_printer bl ~sanitizer:usanitize
let thash = Hid.create 63
let lhash = Hid.create 63
let phash = Hid.create 63
let forget_all () =
forget_all iprinter;
forget_all tprinter;
forget_all lprinter;
forget_all pprinter;
Hid.clear thash;
Hid.clear lhash;
Hid.clear phash
forget_all pprinter
let tv_set = ref Sid.empty
......@@ -81,20 +74,16 @@ let print_th fmt th =
fprintf fmt "%s" (id_unique iprinter ~sanitizer th.th_name)
let print_ts fmt ts =
Hid.replace thash ts.ts_name ts;
fprintf fmt "%s" (id_unique tprinter ts.ts_name)
let print_ls fmt ls =
Hid.replace lhash ls.ls_name ls;
fprintf fmt "%s" (id_unique lprinter ls.ls_name)
let print_cs fmt ls =
Hid.replace lhash ls.ls_name ls;
let sanitizer = String.capitalize in
fprintf fmt "%s" (id_unique lprinter ~sanitizer ls.ls_name)
let print_pr fmt pr =
Hid.replace phash pr.pr_name pr;
fprintf fmt "%s" (id_unique pprinter pr.pr_name)
(** Types *)
......@@ -328,41 +317,35 @@ let print_decl fmt d = match d.d_node with
| Dind il -> print_list newline print_ind_decl fmt il
| Dprop p -> print_prop_decl fmt p
let print_inst fmt (id1,id2) =
if Hid.mem thash id2 then
let n = id_unique tprinter id1 in
fprintf fmt "type %s = %a" n print_ts (Hid.find thash id2)
else if Hid.mem lhash id2 then
let n = id_unique lprinter id1 in
fprintf fmt "logic %s = %a" n print_ls (Hid.find lhash id2)
else if Hid.mem phash id2 then
let n = id_unique pprinter id1 in
fprintf fmt "prop %s = %a" n print_pr (Hid.find phash id2)
else
fprintf fmt "ident %s = %s" id1.id_string id2.id_string
let print_inst_ts fmt (ts1,ts2) =
fprintf fmt "type %a = %a" print_ts ts1 print_ts ts2
let print_inst_ls fmt (ls1,ls2) =
fprintf fmt "logic %a = %a" print_ls ls1 print_ls ls2
let print_inst_pr fmt (pr1,pr2) =
fprintf fmt "prop %a = %a" print_pr pr1 print_pr pr2
let print_meta_arg fmt = function
| MARid id ->
if Hid.mem thash id then
fprintf fmt "type %a" print_ts (Hid.find thash id)
else if Hid.mem lhash id then
fprintf fmt "logic %a" print_ls (Hid.find lhash id)
else if Hid.mem phash id then
fprintf fmt "prop %a" print_pr (Hid.find phash id)
else
fprintf fmt "ident %s" id.id_string
| MARstr s -> fprintf fmt "\"%s\"" s
| MARint i -> fprintf fmt "%d" i
| MAts ts -> fprintf fmt "type %a" print_ts ts
| MAls ls -> fprintf fmt "logic %a" print_ls ls
| MApr pr -> fprintf fmt "prop %a" print_pr pr
| MAstr s -> fprintf fmt "\"%s\"" s
| MAint i -> fprintf fmt "%d" i
let print_tdecl fmt td = match td.td_node with
| Decl d ->
print_decl fmt d
| Use th ->
fprintf fmt "@[<hov 2>(* use %a *)@]" print_th th
| Clone (th,inst) ->
let inst = Mid.fold (fun x y a -> (x,y)::a) inst [] in
fprintf fmt "@[<hov 2>(* clone %a with %a *)@]"
print_th th (print_list comma print_inst) inst
| Clone (th,tm,lm,pm) ->
let tm = Mts.fold (fun x y a -> (x,y)::a) tm [] in
let lm = Mls.fold (fun x y a -> (x,y)::a) lm [] in
let pm = Mpr.fold (fun x y a -> (x,y)::a) pm [] in
fprintf fmt "@[<hov 2>(* clone %a with %a,%a,%a *)@]"
print_th th (print_list comma print_inst_ts) tm
(print_list comma print_inst_ls) lm
(print_list comma print_inst_pr) pm
| Meta (t,al) ->
fprintf fmt "@[<hov 2>(* meta %s %a *)@]"
t (print_list space print_meta_arg) al
......@@ -386,7 +369,7 @@ module NsTree = struct
let contents ns kn =
let add_ns s ns acc = Namespace (s, ns, kn) :: acc in
let add_pr s p acc =
let add_pr s p acc =
let k, _ = find_prop_decl kn p in
Leaf (sprint_pkind k ^ " " ^ s) :: acc in
let add_ls s ls acc =
......@@ -411,7 +394,7 @@ end
let print_namespace fmt name th =
let module P = Print_tree.Make(NsTree) in
fprintf fmt "@[<hov>%a@]@." P.print
fprintf fmt "@[<hov>%a@]@." P.print
(NsTree.Namespace (name, th.th_export, th.th_known))
(* Exception reporting *)
......
src/core/pretty.mli
View file @ 017deebd
......@@ -47,7 +47,7 @@ val print_fmla : formatter -> fmla -> unit (* formula *)
val print_expr : formatter -> expr -> unit (* term or formula *)
val print_pkind : formatter -> prop_kind -> unit
val print_meta_arg : formatter -> meta_arg_real -> unit
val print_meta_arg : formatter -> meta_arg -> unit
val print_type_decl : formatter -> ty_decl -> unit
val print_logic_decl : formatter -> logic_decl -> unit
......
src/core/printer.ml
View file @ 017deebd
......@@ -113,7 +113,8 @@ let print_prelude fmt pl =
let print_th_prelude task fmt pm =
let th_used = task_fold (fun acc -> function
| { td_node = Clone (th,cl) } when Mid.is_empty cl -> th::acc
| { td_node = Clone (th,tm,lm,pm) }
when Mts.is_empty tm && Mls.is_empty lm && Mpr.is_empty pm -> th::acc
| _ -> acc) [] task
in
List.iter (fun th ->
......@@ -140,19 +141,27 @@ let meta_remove_type = register_meta "remove_type" [MTtysymbol]
let meta_remove_logic = register_meta "remove_logic" [MTlsymbol]
let meta_remove_prop = register_meta "remove_prop" [MTprsymbol]
let remove_type ts = create_meta meta_remove_type [MAts ts]
let remove_type ts = create_meta meta_remove_type [MAts ts]
let remove_logic ls = create_meta meta_remove_logic [MAls ls]
let remove_prop pr = create_meta meta_remove_prop [MApr pr]
let remove_prop pr = create_meta meta_remove_prop [MApr pr]
let get_remove_set task =
let add td s = match td.td_node with
| Meta (_,[MARid id]) -> Sid.add id s
let add_ts td s = match td.td_node with
| Meta (_,[MAts ts]) -> Sid.add ts.ts_name s
| _ -> assert false
in
let add_ls td s = match td.td_node with
| Meta (_,[MAls ls]) -> Sid.add ls.ls_name s
| _ -> assert false
in
let add_pr td s = match td.td_node with
| Meta (_,[MApr pr]) -> Sid.add pr.pr_name s
| _ -> assert false
in
let s = Sid.empty in
let s = Stdecl.fold add (find_meta task meta_remove_type).tds_set s in
let s = Stdecl.fold add (find_meta task meta_remove_logic).tds_set s in
let s = Stdecl.fold add (find_meta task meta_remove_prop).tds_set s in
let s = Stdecl.fold add_ts (find_meta task meta_remove_type).tds_set s in
let s = Stdecl.fold add_ls (find_meta task meta_remove_logic).tds_set s in
let s = Stdecl.fold add_pr (find_meta task meta_remove_prop).tds_set s in
s
(** {2 exceptions to use in transformations and printers} *)
......
src/core/task.ml
View file @ 017deebd
......@@ -165,7 +165,7 @@ let add_ind_decls tk dl = List.fold_left add_decl tk (create_ind_decls dl)
let rec add_tdecl task td = match td.td_node with
| Decl d -> new_decl task d td
| Use th -> use_export task th
| Clone (th,_) -> add_clone task th td
| Clone (th,_,_,_) -> add_clone task th td
| Meta (t,_) -> add_meta task t td
and flat_tdecl task td = match td.td_node with
......@@ -215,13 +215,31 @@ let task_decls = task_fold (fun acc td ->
exception NotTaggingMeta of string
let find_tagged t tds acc =
let find_tagged_ts t tds acc =
begin match lookup_meta t with
| [MTtysymbol|MTlsymbol|MTprsymbol] -> ()
| [MTtysymbol] -> ()
| _ -> raise (NotTaggingMeta t)
end;
Stdecl.fold (fun td acc -> match td.td_node with
| Meta (s, [MARid id]) when s = t -> Sid.add id acc
| Meta (s, [MAts ts]) when s = t -> Sts.add ts acc
| _ -> assert false) tds.tds_set acc
let find_tagged_ls t tds acc =
begin match lookup_meta t with
| [MTlsymbol] -> ()
| _ -> raise (NotTaggingMeta t)
end;
Stdecl.fold (fun td acc -> match td.td_node with
| Meta (s, [MAls ls]) when s = t -> Sls.add ls acc
| _ -> assert false) tds.tds_set acc
let find_tagged_pr t tds acc =
begin match lookup_meta t with
| [MTprsymbol] -> ()
| _ -> raise (NotTaggingMeta t)
end;
Stdecl.fold (fun td acc -> match td.td_node with
| Meta (s, [MApr pr]) when s = t -> Spr.add pr acc
| _ -> assert false) tds.tds_set acc
exception NotExclusiveMeta of string
......
src/core/task.mli
View file @ 017deebd
......@@ -99,7 +99,9 @@ val task_goal : task -> prsymbol
exception NotTaggingMeta of string
val find_tagged : string -> tdecl_set -> Sid.t -> Sid.t
val find_tagged_ts : string -> tdecl_set -> Sts.t -> Sts.t
val find_tagged_ls : string -> tdecl_set -> Sls.t -> Sls.t
val find_tagged_pr : string -> tdecl_set -> Spr.t -> Spr.t
(* special selector for exclusive metaproperties *)
......
src/core/theory.ml
View file @ 017deebd
......@@ -96,11 +96,6 @@ type meta_arg =
| MAstr of string
| MAint of int
type meta_arg_real =
| MARid of ident
| MARstr of string
| MARint of int
exception KnownMeta of string
exception UnknownMeta of string
exception BadMetaArity of string * int * int
......@@ -148,8 +143,8 @@ and tdecl = {
and tdecl_node =
| Decl of decl
| Use of theory
| Clone of theory * ident Mid.t
| Meta of string * meta_arg_real list
| Clone of theory * tysymbol Mts.t * lsymbol Mls.t * prsymbol Mpr.t
| Meta of string * meta_arg list
(** Theory declarations *)
......@@ -158,32 +153,42 @@ module Hstdecl = Hashcons.Make (struct
type t = tdecl
let eq_marg a1 a2 = match a1,a2 with
| MARid id1, MARid id2 -> id_equal id1 id2
| MARstr s1, MARstr s2 -> s1 = s2
| MARint i1, MARint i2 -> i1 = i2
| MAts ts1, MAts ts2 -> ts_equal ts1 ts2
| MAls ls1, MAls ls2 -> ls_equal ls1 ls2
| MApr pr1, MApr pr2 -> pr_equal pr1 pr2
| MAstr s1, MAstr s2 -> s1 = s2
| MAint i1, MAint i2 -> i1 = i2
| _,_ -> false
let equal td1 td2 = match td1.td_node, td2.td_node with
| Decl d1, Decl d2 -> d_equal d1 d2
| Use th1, Use th2 -> id_equal th1.th_name th2.th_name
| Clone (th1,cl1), Clone (th2,cl2) ->
| Clone (th1,tm1,lm1,pm1), Clone (th2,tm2,lm2,pm2) ->
id_equal th1.th_name th2.th_name &&
Mid.equal id_equal cl1 cl2
Mts.equal ts_equal tm1 tm2 &&
Mls.equal ls_equal lm1 lm2 &&
Mpr.equal pr_equal pm1 pm2
| Meta (t1,al1), Meta (t2,al2) ->
t1 = t2 && list_all2 eq_marg al1 al2
| _,_ -> false
let hs_cl _ id acc = Hashcons.combine acc id.id_tag
let hs_cl_ts _ ts acc = Hashcons.combine acc ts.ts_name.id_tag
let hs_cl_ls _ ls acc = Hashcons.combine acc ls.ls_name.id_tag
let hs_cl_pr _ pr acc = Hashcons.combine acc pr.pr_name.id_tag
let hs_ta = function
| MARid id -> id.id_tag
| MARstr s -> Hashtbl.hash s
| MARint i -> Hashtbl.hash i
| MAts ts -> ts.ts_name.id_tag
| MAls ls -> ls.ls_name.id_tag
| MApr pr -> pr.pr_name.id_tag
| MAstr s -> Hashtbl.hash s
| MAint i -> Hashtbl.hash i
let hash td = match td.td_node with
| Decl d -> d.d_tag
| Use th -> th.th_name.id_tag
| Clone (th,cl) -> Mid.fold hs_cl cl th.th_name.id_tag
| Clone (th,tm,lm,pm) ->
Mts.fold hs_cl_ts tm (Mls.fold hs_cl_ls lm
(Mpr.fold hs_cl_pr pm th.th_name.id_tag))
| Meta (t,al) -> Hashcons.combine_list hs_ta (Hashtbl.hash t) al
let tag n td = { td with td_tag = n }
......@@ -261,12 +266,16 @@ let close_namespace uc import s =
(* Base constructors *)
let known_clone kn cl =
Mid.iter (fun _ id -> known_id kn id) cl
let known_clone kn tm lm pm =
Mts.iter (fun _ ts -> known_id kn ts.ts_name) tm;
Mls.iter (fun _ ls -> known_id kn ls.ls_name) lm;
Mpr.iter (fun _ pr -> known_id kn pr.pr_name) pm
let known_meta kn al =
let check = function
| MARid id -> known_id kn id
| MAts ts -> known_id kn ts.ts_name
| MAls ls -> known_id kn ls.ls_name
| MApr pr -> known_id kn pr.pr_name
| _ -> ()
in
List.iter check al
......@@ -281,7 +290,7 @@ let add_tdecl uc td = match td.td_node with
uc_decls = td :: uc.uc_decls;
uc_known = merge_known uc.uc_known th.th_known;
uc_used = Sid.union uc.uc_used (Sid.add th.th_name th.th_used) }
| Clone (_,cl) -> known_clone uc.uc_known cl;
| Clone (_,tm,lm,pm) -> known_clone uc.uc_known tm lm pm;
{ uc with uc_decls = td :: uc.uc_decls }
| Meta (_,al) -> known_meta uc.uc_known al;
{ uc with uc_decls = td :: uc.uc_decls }
......@@ -373,72 +382,54 @@ exception CannotInstantiate of ident
type clones = {
cl_local : Sid.t;
ts_table : tysymbol Hts.t;
ls_table : lsymbol Hls.t;
pr_table : prsymbol Hpr.t;
mutable id_table : ident Mid.t;
mutable id_local : Sid.t;
mutable ts_table : tysymbol Mts.t;
mutable ls_table : lsymbol Mls.t;
mutable pr_table : prsymbol Mpr.t;
}
let empty_clones s = {
cl_local = s;
ts_table = Hts.create 17;
ls_table = Hls.create 17;
pr_table = Hpr.create 17;
id_table = Mid.empty;
id_local = Sid.empty;
ts_table = Mts.empty;
ls_table = Mls.empty;
pr_table = Mpr.empty;
}
let cl_add_ts cl ts ts' =
cl.id_table <- Mid.add ts.ts_name ts'.ts_name cl.id_table;
Hts.replace cl.ts_table ts ts'
let cl_add_ls cl ls ls' =
cl.id_table <- Mid.add ls.ls_name ls'.ls_name cl.id_table;
Hls.replace cl.ls_table ls ls'
let cl_add_pr cl pr pr' =
cl.id_table <- Mid.add pr.pr_name pr'.pr_name cl.id_table;
Hpr.replace cl.pr_table pr pr'
(* populate the clone structure *)
let cl_find_id cl id =
if not (Sid.mem id cl.cl_local) then id
else Mid.find id cl.id_table
let rec cl_find_ts cl ts =
if not (Sid.mem ts.ts_name cl.cl_local) then ts
else try Hts.find cl.ts_table ts
else try Mts.find ts cl.ts_table
with Not_found ->
let td' = option_map (cl_trans_ty cl) ts.ts_def in
let ts' = create_tysymbol (id_dup ts.ts_name) ts.ts_args td' in
cl.id_local <- Sid.add ts'.ts_name cl.id_local;
cl_add_ts cl ts ts';
cl.ts_table <- Mts.add ts ts' cl.ts_table;
ts'
and cl_trans_ty cl ty = ty_s_map (cl_find_ts cl) ty
let cl_find_ls cl ls =
if not (Sid.mem ls.ls_name cl.cl_local) then ls
else try Hls.find cl.ls_table ls
else try Mls.find ls cl.ls_table
with Not_found ->
let ta' = List.map (cl_trans_ty cl) ls.ls_args in
let vt' = option_map (cl_trans_ty cl) ls.ls_value in
let ls' = create_lsymbol (id_dup ls.ls_name) ta' vt' in
cl.id_local <- Sid.add ls'.ls_name cl.id_local;
cl_add_ls cl ls ls';
cl.ls_table <- Mls.add ls ls' cl.ls_table;
ls'
let cl_trans_fmla cl f = f_s_map (cl_find_ts cl) (cl_find_ls cl) f
let cl_find_pr cl pr =
if not (Sid.mem pr.pr_name cl.cl_local) then assert false
else try ignore (Hpr.find cl.pr_table pr); assert false
if not (Sid.mem pr.pr_name cl.cl_local) then pr
else try Mpr.find pr cl.pr_table
with Not_found ->
let pr' = create_prsymbol (id_dup pr.pr_name) in
cl.id_local <- Sid.add pr'.pr_name cl.id_local;
cl_add_pr cl pr pr';
cl.pr_table <- Mpr.add pr pr' cl.pr_table;
pr'
(* initialize the clone structure *)
......@@ -451,7 +442,7 @@ let cl_init_ts cl ts ts' =
if not (Sid.mem id cl.cl_local) then raise (NonLocal id);
if List.length ts.ts_args <> List.length ts'.ts_args
then raise (BadInstance (id, ts'.ts_name));
cl_add_ts cl ts ts'
cl.ts_table <- Mts.add ts ts' cl.ts_table
let cl_init_ls cl ls ls' =
let id = ls.ls_name in
......@@ -467,7 +458,7 @@ let cl_init_ls cl ls ls' =
in
ignore (try List.fold_left2 mtch sb ls.ls_args ls'.ls_args
with Invalid_argument _ -> raise (BadInstance (id, ls'.ls_name)));
cl_add_ls cl ls ls'
cl.ls_table <- Mls.add ls ls' cl.ls_table
let cl_init_pr cl pr =
let id = pr.pr_name in
......@@ -564,13 +555,16 @@ let cl_decl cl inst d = match d.d_node with
| Dprop p -> cl_prop cl inst p
let cl_marg cl = function
| MARid id -> MARid (cl_find_id cl id)
| MAts ts -> MAts (cl_find_ts cl ts)
| MAls ls -> MAls (cl_find_ls cl ls)
| MApr pr -> MApr (cl_find_pr cl pr)
| a -> a
let cl_tdecl cl inst td = match td.td_node with
| Decl d -> Decl (cl_decl cl inst d)
| Use th -> Use th
| Clone (th,i) -> Clone (th, Mid.map (cl_find_id cl) i)
| Clone (th,tm,lm,pm) -> Clone (th, Mts.map (cl_find_ts cl) tm,
Mls.map (cl_find_ls cl) lm, Mpr.map (cl_find_pr cl) pm)
| Meta (id,al) -> Meta (id, List.map (cl_marg cl) al)
let clone_theory cl add_td acc th inst =
......@@ -582,7 +576,7 @@ let clone_theory cl add_td acc th inst =
option_apply acc (add_td acc) td
in
let acc = List.fold_left add acc th.th_decls in
add_td acc (mk_tdecl (Clone (th, cl.id_table)))
add_td acc (mk_tdecl (Clone (th, cl.ts_table, cl.ls_table, cl.pr_table)))
let clone_export uc th inst =
let cl = cl_init th inst in
......@@ -593,21 +587,21 @@ let clone_export uc th inst =
let f_ts n ts ns =
if Sid.mem ts.ts_name th.th_local then
let ts' = Hts.find cl.ts_table ts in
let ts' = Mts.find ts cl.ts_table in
if Sid.mem ts'.ts_name cl.id_local
then add_ts true n ts' ns else ns
else add_ts true n ts ns in
let f_ls n ls ns =
if Sid.mem ls.ls_name th.th_local then
let ls' = Hls.find cl.ls_table ls in
let ls' = Mls.find ls cl.ls_table in
if Sid.mem ls'.ls_name cl.id_local
then add_ls true n ls' ns else ns
else add_ls true n ls ns in
let f_pr n pr ns =
if Sid.mem pr.pr_name th.th_local then
let pr' = Hpr.find cl.pr_table pr in
let pr' = Mpr.find pr cl.pr_table in
if Sid.mem pr'.pr_name cl.id_local
then add_pr true n pr' ns else ns
else add_pr true n pr ns in
......@@ -633,7 +627,8 @@ let clone_theory add_td acc th inst =
let create_clone = clone_theory (fun tdl td -> td :: tdl)
let create_null_clone th = mk_tdecl (Clone (th,Mid.empty))
let create_null_clone th =
mk_tdecl (Clone (th, Mts.empty, Mls.empty, Mpr.empty))
(** Meta properties *)
......@@ -649,15 +644,11 @@ let create_meta s al =
let atl = try Hashtbl.find meta_table s
with Not_found -> raise (UnknownMeta s)
in
let get_meta_arg_real at a = match at, a with
| MTtysymbol, MAts ts -> MARid ts.ts_name
| MTlsymbol, MAls ls -> MARid ls.ls_name
| MTprsymbol, MApr pr -> MARid pr.pr_name
| MTstring, MAstr s -> MARstr s
| MTint, MAint i -> MARint i
| _,_ -> raise (MetaTypeMismatch (s, at, get_meta_arg_type a))
let get_meta_arg at a =
let mt = get_meta_arg_type a in
if at = mt then a else raise (MetaTypeMismatch (s,at,mt))
in
let al = try List.map2 get_meta_arg_real atl al
let al = try List.map2 get_meta_arg atl al
with Invalid_argument _ ->
raise (BadMetaArity (s, List.length atl, List.length al))
in
......@@ -666,9 +657,16 @@ let create_meta s al =
let add_meta uc s al = add_tdecl uc (create_meta s al)
let clone_meta tdt th tdc = match tdt.td_node, tdc.td_node with
| Meta (t,al), Clone (th',cl) when id_equal th.th_name th'.th_name ->
let find_id id = try Mid.find id cl with Not_found -> id in
let cl_marg = function MARid id -> MARid (find_id id) | a -> a in
| Meta (t,al), Clone (th',tm,lm,pm) when id_equal th.th_name th'.th_name ->
let find_ts ts = try Mts.find ts tm with Not_found -> ts in
let find_ls ls = try Mls.find ls lm with Not_found -> ls in
let find_pr pr = try Mpr.find pr pm with Not_found -> pr in
let cl_marg = function
| MAts ts -> MAts (find_ts ts)
| MAls ls -> MAls (find_ls ls)
| MApr pr -> MApr (find_pr pr)
| a -> a
in
mk_tdecl (Meta (t, List.map cl_marg al))
| _,_ -> invalid_arg "clone_meta"
......
src/core/theory.mli
View file @ 017deebd
......@@ -54,11 +54,6 @@ type meta_arg =
| MAstr of string
| MAint of int
type meta_arg_real =
| MARid of ident
| MARstr of string
| MARint of int
val register_meta : string -> meta_arg_type list -> string
val register_meta_exc : string -> meta_arg_type list -> string
......@@ -86,8 +81,8 @@ and tdecl = private {
and tdecl_node = private
| Decl of decl
| Use of theory
| Clone of theory * ident Mid.t
| Meta of string * meta_arg_real list
| Clone of theory * tysymbol Mts.t * lsymbol Mls.t * prsymbol Mpr.t
| Meta of string * meta_arg list
module Stdecl : Set.S with type elt = tdecl
module Mtdecl : Map.S with type key = tdecl
......
src/driver/driver.ml
View file @ 017deebd
......@@ -224,9 +224,10 @@ let print_task ?(debug=false) drv fmt task =
Mid.fold (fun _ (th,s) task ->
let cs = (find_clone task th).tds_set in
Stdecl.fold (fun td task -> match td.td_node with
| Clone (_,cl) when Mid.is_empty cl ->
| Clone (_,tm,lm,pm)
when Mts.is_empty tm && Mls.is_empty lm && Mpr.is_empty pm ->
Stdecl.fold (fun td task -> add_tdecl task td) s task
| _ -> assert false (* impossible *)
| _ -> task
) cs task
) drv.drv_meta task
in
......
src/printer/alt_ergo.ml
View file @ 017deebd
......@@ -53,7 +53,7 @@ let forget_var v = forget_id ident_printer v.vs_name
type info = {
info_syn : syntax_map;
info_rem : Sid.t;
info_ac : Sid.t;
info_ac : Sls.t;
}
let rec print_type info fmt ty = match ty.ty_node with
......@@ -167,7 +167,7 @@ let ac_th = ["algebra";"AC"]
let print_logic_decl info fmt (ls,ld) =
match ld with
| None ->
let sac = if Sid.mem ls.ls_name info.info_ac then "ac " else "" in
let sac = if Sls.mem ls info.info_ac then "ac " else "" in
fprintf fmt "@[<hov 2>logic %s%a : %a%s%a@]@\n"
sac print_ident ls.ls_name
(print_list comma (print_type info)) ls.ls_args
......@@ -220,7 +220,8 @@ let print_task pr thpr syn fmt task =
let info = {
info_syn = syn;
info_rem = get_remove_set task;
info_ac = Task.find_tagged meta_ac (find_meta task meta_ac) Sid.empty }
info_ac =
Task.find_tagged_ls meta_ac (find_meta task meta_ac) Sls.empty }
in
let decls = Task.task_decls task in
ignore (print_list_opt (add_flush newline2) (print_decl info) fmt decls)
......