Isabelle_DOF
/
Isabelle_DOF
1
0
Fork 2
Code Issues 1 Pull Requests Releases Wiki Activity

Some cleanup
ci/woodpecker/push/build Pipeline failed Details

This commit is contained in:
Nicolas Méric 2023-02-17 09:08:34 +01:00
parent 9de18b148a
commit bdfea3ddb1
1 changed files with 42 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
src/DOF/Isa_DOF.thy
View File

@ -200,16 +200,13 @@ struct
#1 o Name_Space.check (Context.Proof ctxt) (get_onto_classes ctxt); #1 o Name_Space.check (Context.Proof ctxt) (get_onto_classes ctxt);
fun add_onto_class name onto_class thy = fun add_onto_class name onto_class thy =
thy |> Onto_Classes.map thy |> Onto_Classes.map (Name_Space.define (Context.Theory thy) true (name, onto_class) #> #2);
(Name_Space.define (Context.Theory thy) true (name, onto_class) #> #2);
fun update_onto_class name onto_class thy = fun update_onto_class name onto_class thy =
thy |> Onto_Classes.map thy |> Onto_Classes.map (Name_Space.define (Context.Theory thy) false (name, onto_class) #> #2);
(Name_Space.define (Context.Theory thy) false (name, onto_class) #> #2);
fun update_onto_class_entry name new_onto_class thy = fun update_onto_class_entry name new_onto_class =
thy |> Onto_Classes.map Onto_Classes.map (Name_Space.map_table_entry name (K new_onto_class));
(Name_Space.map_table_entry name (fn _ => new_onto_class));
fun print_onto_classes verbose ctxt = fun print_onto_classes verbose ctxt =
Pretty.big_list "Isabelle.DOF Onto_Classes:" Pretty.big_list "Isabelle.DOF Onto_Classes:"
@ -288,16 +285,13 @@ struct
#1 o Name_Space.check (Context.Proof ctxt) (get_instances ctxt); #1 o Name_Space.check (Context.Proof ctxt) (get_instances ctxt);
fun add_instance name instance thy = fun add_instance name instance thy =
thy |> Instances.map thy |> Instances.map (Name_Space.define (Context.Theory thy) true (name, instance) #> #2);
(Name_Space.define (Context.Theory thy) true (name, instance) #> #2);
fun update_instance name instance thy = fun update_instance name instance thy =
thy |> Instances.map thy |> Instances.map (Name_Space.define (Context.Theory thy) false (name, instance) #> #2);
(Name_Space.define (Context.Theory thy) false (name, instance) #> #2);
fun update_instance_entry name new_instance thy = fun update_instance_entry name new_instance =
thy |> Instances.map Instances.map (Name_Space.map_table_entry name (K new_instance));
(Name_Space.map_table_entry name (fn _ => new_instance));
fun print_instances verbose ctxt = fun print_instances verbose ctxt =
Pretty.big_list "Isabelle.DOF Instances:" Pretty.big_list "Isabelle.DOF Instances:"
@ -338,8 +332,7 @@ struct
(Name_Space.define (Context.Theory thy) false (name, isa_transformer) #> #2); (Name_Space.define (Context.Theory thy) false (name, isa_transformer) #> #2);
fun update_isa_transformer_entry name new_isa_transformer thy = fun update_isa_transformer_entry name new_isa_transformer thy =
thy |> ISA_Transformers.map ISA_Transformers.map (Name_Space.map_table_entry name (K new_isa_transformer));
(Name_Space.map_table_entry name (fn _ => new_isa_transformer));
fun print_isa_transformers verbose ctxt = fun print_isa_transformers verbose ctxt =
Pretty.big_list "Isabelle.DOF ISA_Transformers:" Pretty.big_list "Isabelle.DOF ISA_Transformers:"
@ -382,9 +375,8 @@ struct
thy |> ML_Invariants.map thy |> ML_Invariants.map
(Name_Space.define (Context.Theory thy) false (name, ml_invariant) #> #2); (Name_Space.define (Context.Theory thy) false (name, ml_invariant) #> #2);
fun update_ml_invariant_entry name new_ml_invariant thy = fun update_ml_invariant_entry name new_ml_invariant =
thy |> ML_Invariants.map ML_Invariants.map (Name_Space.map_table_entry name (K new_ml_invariant));
(Name_Space.map_table_entry name (fn _ => new_ml_invariant));
fun print_ml_invariants verbose ctxt = fun print_ml_invariants verbose ctxt =
Pretty.big_list "Isabelle.DOF ML_Invariants:" Pretty.big_list "Isabelle.DOF ML_Invariants:"
@ -425,9 +417,8 @@ struct
thy |> Opening_ML_Invariants.map thy |> Opening_ML_Invariants.map
(Name_Space.define (Context.Theory thy) false (name, opening_ml_invariant) #> #2); (Name_Space.define (Context.Theory thy) false (name, opening_ml_invariant) #> #2);
fun update_opening_ml_invariant_entry name new_opening_ml_invariant thy = fun update_opening_ml_invariant_entry name new_opening_ml_invariant =
thy |> Opening_ML_Invariants.map Opening_ML_Invariants.map (Name_Space.map_table_entry name (K new_opening_ml_invariant));
(Name_Space.map_table_entry name (fn _ => new_opening_ml_invariant));
fun print_opening_ml_invariants verbose ctxt = fun print_opening_ml_invariants verbose ctxt =
Pretty.big_list "Isabelle.DOF Opening_ML_Invariants:" Pretty.big_list "Isabelle.DOF Opening_ML_Invariants:"
@ -467,9 +458,8 @@ struct
thy |> Closing_ML_Invariants.map thy |> Closing_ML_Invariants.map
(Name_Space.define (Context.Theory thy) false (name, closing_ml_invariant) #> #2); (Name_Space.define (Context.Theory thy) false (name, closing_ml_invariant) #> #2);
fun update_closing_ml_invariant_entry name new_closing_ml_invariant thy = fun update_closing_ml_invariant_entry name new_closing_ml_invariant =
thy |> Closing_ML_Invariants.map Closing_ML_Invariants.map (Name_Space.map_table_entry name (K new_closing_ml_invariant));
(Name_Space.map_table_entry name (fn _ => new_closing_ml_invariant));
fun print_closing_ml_invariants verbose ctxt = fun print_closing_ml_invariants verbose ctxt =
Pretty.big_list "Isabelle.DOF Closing_ML_Invariants:" Pretty.big_list "Isabelle.DOF Closing_ML_Invariants:"
@ -521,9 +511,8 @@ struct
thy |> Monitor_Info.map thy |> Monitor_Info.map
(Name_Space.define (Context.Theory thy) false (name, monitor_info) #> #2); (Name_Space.define (Context.Theory thy) false (name, monitor_info) #> #2);
fun update_monitor_info_entry name new_monitor_info thy = fun update_monitor_info_entry name new_monitor_info =
thy |> Monitor_Info.map Monitor_Info.map (Name_Space.map_table_entry name (K new_monitor_info));
(Name_Space.map_table_entry name (fn _ => new_monitor_info));
fun print_monitors_infos verbose ctxt = fun print_monitors_infos verbose ctxt =
Pretty.big_list "Isabelle.DOF Monitor_Infos:" Pretty.big_list "Isabelle.DOF Monitor_Infos:"
@ -618,25 +607,25 @@ fun define_doc_class_global (params', binding) parent fields rexp reject_Atoms i
, rejectS, reg_exps, invs')) , rejectS, reg_exps, invs'))
end end
fun define_object_global {define = define} ((oid, pos), bbb) thy = fun define_object_global {define = define} ((oid, pos), instance) thy =
let let
val binding = if Long_Name.is_qualified oid val binding = if Long_Name.is_qualified oid
then Binding.make (Long_Name.base_name oid, pos) then Binding.make (Long_Name.base_name oid, pos)
else Binding.make (oid, pos) else Binding.make (oid, pos)
val undefined_instance = "undefined_instance" val undefined_instance = "undefined_instance"
val (oid', instance) = Name_Space.check (Context.Theory thy) val (oid', instance') = Name_Space.check (Context.Theory thy)
(get_instances (Proof_Context.init_global thy)) (oid, Position.none) (get_instances (Proof_Context.init_global thy)) (oid, Position.none)
handle ERROR _ => (undefined_instance, empty_instance) handle ERROR _ => (undefined_instance, empty_instance)
val {input_term, value, inline, cid, vcid, ...} = bbb val Instance {input_term, value, inline, cid, vcid, ...} = instance
val instance' = make_instance (define, input_term, value, inline, cid, vcid) val instance'' = make_instance (define, input_term, value, inline, cid, vcid)
in if oid' = undefined_instance andalso instance = empty_instance in if oid' = undefined_instance andalso instance' = empty_instance
then add_instance binding instance' thy then add_instance binding instance'' thy
else if define else if define
then let val Instance {defined, ...} = instance then let val Instance {defined, ...} = instance'
in if defined in if defined
then add_instance binding instance' thy then add_instance binding instance'' thy
else update_instance_entry oid' instance' thy end else update_instance_entry oid' instance'' thy end
else add_instance binding (Instance bbb) thy else add_instance binding instance thy
end end
@ -718,15 +707,14 @@ fun update_value_global name upd_value thy =
val binding = binding_from_instance_pos name thy val binding = binding_from_instance_pos name thy
val Instance {defined, input_term, value, inline, cid, vcid} = get_instance_global name thy val Instance {defined, input_term, value, inline, cid, vcid} = get_instance_global name thy
val instance' = make_instance (defined, input_term, upd_value value, inline, cid, vcid) val instance' = make_instance (defined, input_term, upd_value value, inline, cid, vcid)
in update_instance binding (instance') thy end in update_instance binding instance' thy end
fun update_input_term_global name upd_input_term thy = fun update_input_term_global name upd_input_term thy =
let let
val binding = binding_from_instance_pos name thy val binding = binding_from_instance_pos name thy
val Instance {defined, input_term, value, inline, cid, vcid} = get_instance_global name thy val Instance {defined, input_term, value, inline, cid, vcid} = get_instance_global name thy
val instance' = make_instance (defined, upd_input_term input_term, val instance' = make_instance (defined, upd_input_term input_term, value, inline, cid, vcid)
value, inline, cid, vcid) in update_instance binding instance' thy end
in update_instance binding (instance') thy end
fun update_value_input_term_global name upd_input_term upd_value thy = fun update_value_input_term_global name upd_input_term upd_value thy =
update_value_global name upd_value thy |> update_input_term_global name upd_input_term update_value_global name upd_value thy |> update_input_term_global name upd_input_term
@ -1091,8 +1079,8 @@ fun declare_ISA_class_accessor_and_check_instance doc_class_name =
val mixfix_string = "@{" ^ conv_class_name ^ " _}" val mixfix_string = "@{" ^ conv_class_name ^ " _}"
in in
Sign.add_consts_cmd [(bind, typestring, Mixfix.mixfix(mixfix_string))] Sign.add_consts_cmd [(bind, typestring, Mixfix.mixfix(mixfix_string))]
#> DOF_core.add_isa_transformer bind (DOF_core.make_isa_transformer #> DOF_core.add_isa_transformer bind ((check_instance, elaborate_instance)
(check_instance, elaborate_instance)) |> DOF_core.make_isa_transformer)
end end
fun elaborate_instances_list thy isa_name _ _ pos = fun elaborate_instances_list thy isa_name _ _ pos =
@ -1128,8 +1116,8 @@ fun declare_class_instances_annotation thy doc_class_name =
val mixfix_string = "@{" ^ conv_class_name' ^ "}" val mixfix_string = "@{" ^ conv_class_name' ^ "}"
in in
Sign.add_consts [(bind', class_list_typ, Mixfix.mixfix(mixfix_string))] Sign.add_consts [(bind', class_list_typ, Mixfix.mixfix(mixfix_string))]
#> DOF_core.add_isa_transformer bind' (DOF_core.make_isa_transformer #> DOF_core.add_isa_transformer bind' ((check_identity, elaborate_instances_list)
(check_identity, elaborate_instances_list)) |> DOF_core.make_isa_transformer)
end end
fun symbex_attr_access0 ctxt proj_term term = fun symbex_attr_access0 ctxt proj_term term =
@ -1620,8 +1608,8 @@ fun register_oid_cid_in_open_monitors oid pos cid_pos thy =
val delta_autoS = map is_enabled_for_cid enabled_monitors; val delta_autoS = map is_enabled_for_cid enabled_monitors;
fun update_info (n, aS, monitor_info) = fun update_info (n, aS, monitor_info) =
let val DOF_core.Monitor_Info {accepted_cids,rejected_cids,...} = monitor_info let val DOF_core.Monitor_Info {accepted_cids,rejected_cids,...} = monitor_info
in Name_Space.map_table_entry n (fn _ => DOF_core.make_monitor_info in Name_Space.map_table_entry n (K ((accepted_cids, rejected_cids, aS)
(accepted_cids, rejected_cids, aS)) |> DOF_core.make_monitor_info))
end end
fun update_trace mon_oid = fun update_trace mon_oid =
if Config.get_global thy DOF_core.object_value_debug if Config.get_global thy DOF_core.object_value_debug
@ -1749,13 +1737,12 @@ fun create_and_check_docitem is_monitor {is_inline=is_inline} {define=define} oi
in case check_option of in case check_option of
NONE => (K true) NONE => (K true)
| SOME check => (check oid is_monitor) end) | SOME check => (check oid is_monitor) end)
in thy |> DOF_core.define_object_global {define = define} ((oid, pos), {defined = false, in thy |> DOF_core.define_object_global
input_term = fst value_terms, {define = define} ((oid, pos), DOF_core.make_instance
value = value (Proof_Context.init_global thy) (false, fst value_terms,
(snd value_terms), (snd value_terms)
inline = is_inline, |> value (Proof_Context.init_global thy),
cid = cid_long, is_inline, cid_long, vcid))
vcid = vcid})
|> register_oid_cid_in_open_monitors oid pos cid_pos' |> register_oid_cid_in_open_monitors oid pos cid_pos'
|> (fn thy => if #is_monitor(is_monitor) |> (fn thy => if #is_monitor(is_monitor)
then ((Context.Theory then ((Context.Theory