diff --git a/core/KaSa_rep/frontend/ckappa_sig.ml b/core/KaSa_rep/frontend/ckappa_sig.ml index f17b89eba..3d4a98b8d 100644 --- a/core/KaSa_rep/frontend/ckappa_sig.ml +++ b/core/KaSa_rep/frontend/ckappa_sig.ml @@ -39,16 +39,18 @@ type mixture = | PLUS of c_agent_id * agent * mixture | EMPTY_MIX -and agent = { +and 'counter parametric_agent = { agent_name: string; - ag_intf: interface; + ag_intf: 'counter interface; agent_name_pos: position; (*; ag_pos:position*) } -and interface = +and agent = counter parametric_agent +and agent_sig = counter_sig parametric_agent +and 'counter interface = | EMPTY_INTF - | PORT_SEP of port * interface - | COUNTER_SEP of counter * interface + | PORT_SEP of port * 'counter interface + | COUNTER_SEP of 'counter * 'counter interface and port = { port_name: string; @@ -63,7 +65,14 @@ and counter = { counter_test: counter_test option; counter_delta: int option; } - +and counter_sig = + { + counter_sig_name: string; + counter_sig_default: int; + counter_sig_min: int option option; + counter_sig_max: int option option; + counter_visible: bool; + } and counter_test = CEQ of int | CGTE of int | CVAR of string | UNKNOWN and internal = string option list @@ -112,8 +121,8 @@ type ('pattern, 'rule) modif_expr = type 'pattern variable = ('pattern, string) Ast.variable_def -type ('agent, 'pattern, 'mixture, 'rule) compil = - ('agent, 'pattern, 'mixture, string, 'rule) Ast.compil +type ('agent, 'agent_sig, 'pattern, 'mixture, 'rule) compil = + ('agent, 'agent_sig, 'pattern, 'mixture, string, 'rule) Ast.compil type ('a, 'b, 'c) site_type = Internal of 'a | Binding of 'b | Counter of 'c type site = (site_name, site_name, site_name) site_type @@ -869,7 +878,7 @@ type enriched_init = { type c_compil = { c_variables: c_variable Int_storage.Nearly_inf_Imperatif.t; (*pattern declaration for reusing as variable in perturbations or kinetic rate*) - c_signatures: (agent * position) Int_storage.Nearly_inf_Imperatif.t; + c_signatures: (agent_sig * position) Int_storage.Nearly_inf_Imperatif.t; (*agent signature declaration*) c_rules: enriched_rule Int_storage.Nearly_inf_Imperatif.t; (*rules (possibly named)*) diff --git a/core/KaSa_rep/frontend/ckappa_sig.mli b/core/KaSa_rep/frontend/ckappa_sig.mli index 0b5272e80..9b1dca2c7 100644 --- a/core/KaSa_rep/frontend/ckappa_sig.mli +++ b/core/KaSa_rep/frontend/ckappa_sig.mli @@ -112,23 +112,27 @@ val compare_unit_agent_site : unit -> unit -> int type binding_state = Free | Lnk_type of agent_name * site_name -type mixture = +type mixture = | SKIP of mixture | COMMA of agent * mixture | DOT of c_agent_id * agent * mixture | PLUS of c_agent_id * agent * mixture | EMPTY_MIX -and agent = { +and 'counter parametric_agent = { agent_name: string; - ag_intf: interface; + ag_intf: 'counter interface; agent_name_pos: position; (*; ag_pos:position*) } -and interface = +and agent_sig = counter_sig parametric_agent +and agent = counter parametric_agent + +and 'counter interface = | EMPTY_INTF - | PORT_SEP of port * interface - | COUNTER_SEP of counter * interface + | PORT_SEP of port * 'counter interface + | COUNTER_SEP of 'counter * 'counter interface + and port = { port_name: string; @@ -143,6 +147,15 @@ and counter = { counter_delta: int option; } +and counter_sig = + { + counter_sig_name: string; + counter_sig_default: int; + counter_sig_min: int option option; + counter_sig_max: int option option; + counter_visible: bool; + } + and counter_test = CEQ of int | CGTE of int | CVAR of string | UNKNOWN and internal = string option list @@ -187,8 +200,8 @@ type ('pattern, 'rule) modif_expr = type 'pattern variable = ('pattern, string) Ast.variable_def -type ('agent, 'pattern, 'mixture, 'rule) compil = - ('agent, 'pattern, 'mixture, string, 'rule) Ast.compil +type ('agent, 'agent_sig, 'pattern, 'mixture, 'rule) compil = + ('agent, 'agent_sig, 'pattern, 'mixture, string, 'rule) Ast.compil type ('a, 'b, 'c) site_type = Internal of 'a | Binding of 'b | Counter of 'c type site = (site_name, site_name, site_name) site_type @@ -415,7 +428,7 @@ type enriched_init = { type c_compil = { c_variables: c_variable Int_storage.Nearly_inf_Imperatif.t; (*pattern declaration for reusing as variable in perturbations or kinetic rate*) - c_signatures: (agent * position) Int_storage.Nearly_inf_Imperatif.t; + c_signatures: (agent_sig * position) Int_storage.Nearly_inf_Imperatif.t; (*agent signature declaration*) c_rules: enriched_rule Int_storage.Nearly_inf_Imperatif.t; (*rules (possibly named)*) diff --git a/core/KaSa_rep/frontend/list_tokens.ml b/core/KaSa_rep/frontend/list_tokens.ml index bb0614bb6..6847add0d 100644 --- a/core/KaSa_rep/frontend/list_tokens.ml +++ b/core/KaSa_rep/frontend/list_tokens.ml @@ -285,7 +285,7 @@ let declare_dual parameter error handler ag site state ag' site' state' = in error, { handler with Cckappa_sig.dual } -let scan_agent parameters (error, handler) agent = +let scan_agent ~get_counter_name parameters (error, handler) agent = let error, (handler, ag_id) = declare_agent parameters error handler agent.Ckappa_sig.agent_name (Some agent.Ckappa_sig.agent_name_pos) @@ -296,7 +296,7 @@ let scan_agent parameters (error, handler) agent = | Ckappa_sig.COUNTER_SEP (counter, interface) -> let error, (handler, _, _c) = declare_site_with_counter parameters (error, handler) ag_id - counter.Ckappa_sig.counter_name + (get_counter_name counter) in aux error interface handler | Ckappa_sig.PORT_SEP (port, interface) -> @@ -366,6 +366,11 @@ let scan_agent parameters (error, handler) agent = in aux error agent.Ckappa_sig.ag_intf handler +let get_counter_name c = c.Ckappa_sig.counter_name +let get_counter_name_sig c = c.Ckappa_sig.counter_sig_name + +let scan_agent_sig = scan_agent ~get_counter_name:get_counter_name_sig +let scan_agent = scan_agent ~get_counter_name let rec scan_mixture parameters remanent mixture = match mixture with | Ckappa_sig.EMPTY_MIX -> remanent @@ -401,7 +406,7 @@ let scan_initial_states parameters = List.fold_left (scan_token parameters) remanent tk_l) let scan_declarations parameters = - List.fold_left (fun remanent a -> scan_agent parameters remanent a) + List.fold_left (fun remanent a -> scan_agent_sig parameters remanent a) let scan_observables _scan_mixt _parameters remanent _variable = (*TODO*) @@ -474,7 +479,7 @@ let scan_compil parameters error compil = remanent in let remanent = empty_handler parameters error in - let remanent = scan_declarations parameters remanent compil.Ast.signatures in + let remanent = scan_declarations parameters remanent (compil.Ast.signatures:Ckappa_sig.agent_sig list) in let remanent = scan_initial_states parameters remanent compil.Ast.init in let remanent = scan_observables scan_tested_mixture parameters remanent diff --git a/core/KaSa_rep/frontend/list_tokens.mli b/core/KaSa_rep/frontend/list_tokens.mli index e2e4c846a..465988543 100644 --- a/core/KaSa_rep/frontend/list_tokens.mli +++ b/core/KaSa_rep/frontend/list_tokens.mli @@ -6,6 +6,7 @@ val scan_compil : Remanent_parameters_sig.parameters -> Exception_without_parameter.method_handler -> ( Ckappa_sig.agent, + Ckappa_sig.agent_sig, Ckappa_sig.mixture, Ckappa_sig.mixture, 'a, diff --git a/core/KaSa_rep/frontend/prepreprocess.ml b/core/KaSa_rep/frontend/prepreprocess.ml index 98c968132..01f044a8a 100644 --- a/core/KaSa_rep/frontend/prepreprocess.ml +++ b/core/KaSa_rep/frontend/prepreprocess.ml @@ -109,24 +109,27 @@ let pop_entry parameters error id (map, set) = | None -> Exception.warn parameters error __POS__ Exit (None, map) ) -let rec scan_interface parameters k agent interface +let get_counter_name counter = fst counter.Ast.counter_name +let get_counter_name_sig counter = fst counter.Ast.counter_sig_name + +let rec scan_interface ~get_counter_name parameters k agent interface (((error, a), (set_sites, set_counters)) as remanent) = match interface with | [] -> remanent | Ast.Counter counter :: interface -> let error, set_counters = check_freshness parameters error "Counter" - (fst counter.Ast.counter_name) + (get_counter_name counter) set_counters in - scan_interface parameters k agent interface + scan_interface ~get_counter_name parameters k agent interface ((error, a), (set_sites, set_counters)) | Ast.Port port :: interface -> let error, set_sites = check_freshness parameters error "Site" (fst port.Ast.port_name) set_sites in let remanent = error, a in - scan_interface parameters k agent interface + scan_interface ~get_counter_name parameters k agent interface ( (match port.Ast.port_link with | [ (LKappa.LNK_VALUE (i, ()), _) ] -> add_entry_link parameters @@ -141,14 +144,17 @@ let rec scan_interface parameters k agent interface remanent), (set_sites, set_counters) ) -let scan_agent parameters k ag remanent = +let scan_agent ~get_counter_name parameters k ag remanent = match ag with | Ast.Absent _ -> remanent | Ast.Present ((name, _), intf, _modif) -> fst - (scan_interface parameters k name intf + (scan_interface ~get_counter_name parameters k name intf (remanent, (Mods.StringSet.empty, Mods.StringSet.empty))) +let scan_agent_sig = scan_agent ~get_counter_name:get_counter_name_sig +let scan_agent = scan_agent ~get_counter_name + let rec collect_binding_label parameters mixture f k remanent = match mixture with | agent :: mixture (*| Ast.DOT (_,agent,mixture) | Ast.PLUS(_,agent,mixture)*) @@ -176,6 +182,7 @@ let collect_binding_label parameters mixture f k remanent = map (error, (map, Ckappa_sig.Lnk_id_map_and_set.Set.empty)) + let translate_link_state parameters lnk_state remanent = match lnk_state with | [ (LKappa.LNK_VALUE (id, ()), pos) ] -> @@ -282,7 +289,28 @@ let translate_counter parameters error int_set counter = Some a); } ) -let rec translate_interface parameters is_signature int_set_sites +let translate_counter_sig parameters error int_set (counter:Ast.counter_sig) = + let error, _ = + check_freshness parameters error "Counters" + (fst counter.Ast.counter_sig_name) + int_set + in + let fetch x = + match x with + | Some (x,_) -> Some x + | None -> None + in + ( error, + { + Ckappa_sig.counter_sig_name = fst counter.Ast.counter_sig_name; + Ckappa_sig.counter_sig_max = fetch counter.Ast.counter_sig_max; + Ckappa_sig.counter_sig_min = fetch counter.Ast.counter_sig_min; + Ckappa_sig.counter_sig_default = counter.Ast.counter_sig_default; + Ckappa_sig.counter_visible = counter.Ast.counter_sig_visible; + } ) + + +let rec translate_interface ~translate_counter parameters is_signature int_set_sites int_set_counters interface remanent = match interface with | [] -> Ckappa_sig.EMPTY_INTF, remanent @@ -292,7 +320,7 @@ let rec translate_interface parameters is_signature int_set_sites translate_counter parameters error int_set_counters counter in let interface, remanent = - translate_interface parameters is_signature int_set_sites int_set_counters + translate_interface ~translate_counter parameters is_signature int_set_sites int_set_counters interface (error, a) in Ckappa_sig.COUNTER_SEP (counter, interface), remanent @@ -301,21 +329,21 @@ let rec translate_interface parameters is_signature int_set_sites translate_port is_signature parameters int_set_sites port remanent in let interface, remanent = - translate_interface parameters is_signature int_set_sites int_set_counters + translate_interface ~translate_counter parameters is_signature int_set_sites int_set_counters interface remanent in Ckappa_sig.PORT_SEP (port, interface), remanent -let translate_interface parameters is_signature = - translate_interface parameters is_signature Mods.StringSet.empty +let translate_interface ~translate_counter parameters is_signature = + translate_interface ~translate_counter parameters is_signature Mods.StringSet.empty Mods.StringSet.empty -let translate_agent parameters is_signature ag remanent = +let translate_agent ~translate_counter parameters is_signature ag remanent = match ag with | Ast.Absent _pos -> None, remanent | Ast.Present ((agent_name, agent_name_pos), intf, _modif) -> let interface, remanent = - translate_interface parameters is_signature intf remanent + translate_interface ~translate_counter parameters is_signature intf remanent in ( Some { @@ -340,7 +368,7 @@ let rec translate_mixture_zero_zero parameters mixture remanent tail_size = match mixture with | [] -> build_skip tail_size Ckappa_sig.EMPTY_MIX, remanent | agent :: mixture -> - let agent_opt, remanent = translate_agent parameters false agent remanent in + let agent_opt, remanent = translate_agent ~translate_counter parameters false agent remanent in let mixture, remanent = translate_mixture_zero_zero parameters mixture remanent tail_size in @@ -358,7 +386,7 @@ let rec translate_mixture_in_rule parameters mixture remanent prefix_size | [] -> Ckappa_sig.EMPTY_MIX, remanent | agent :: mixture -> let agent_opt, remanent = - translate_agent parameters false agent remanent + translate_agent ~translate_counter parameters false agent remanent in let mixture, remanent = translate_mixture_in_rule parameters mixture remanent (prefix_size - 1) @@ -367,12 +395,12 @@ let rec translate_mixture_in_rule parameters mixture remanent prefix_size add_agent agent_opt mixture remanent ) -let rec translate_mixture parameters mixture remanent = +let rec translate_mixture ~translate_counter parameters mixture remanent = match mixture with | [] -> Ckappa_sig.EMPTY_MIX, remanent | agent :: mixture -> - let agent_opt, remanent = translate_agent parameters false agent remanent in - let mixture, remanent = translate_mixture parameters mixture remanent in + let agent_opt, remanent = translate_agent ~translate_counter parameters false agent remanent in + let mixture, remanent = translate_mixture ~translate_counter parameters mixture remanent in add_agent agent_opt mixture remanent let support_agent = function @@ -435,12 +463,12 @@ let refine_mixture_in_rule parameters error prefix_size empty_size tail_size (error, Ckappa_sig.Lnk_id_map_and_set.Map.empty) in let mixture, (error, _map) = - translate_mixture_in_rule parameters mixture remanent prefix_size empty_size + translate_mixture_in_rule parameters mixture remanent prefix_size empty_size tail_size in error, mixture -let refine_mixture parameters error mixture = +let refine_mixture ~collect_binding_label ~translate_counter parameters error (mixture:Ast.agent list list) = let mixture = List.flatten mixture in let remanent = collect_binding_label parameters mixture @@ -448,9 +476,12 @@ let refine_mixture parameters error mixture = Ckappa_sig.dummy_agent_id (error, Ckappa_sig.Lnk_id_map_and_set.Map.empty) in - let mixture, (error, _map) = translate_mixture parameters mixture remanent in + let mixture, (error, _map) = translate_mixture ~translate_counter parameters mixture remanent in error, mixture +(*let refine_mixture_sig = refine_mixture ~collect_binding_label:collect_binding_label_sig ~translate_counter:translate_counter_sig*) +let refine_mixture = refine_mixture ~collect_binding_label ~translate_counter + let rec alg_map f error alg = match alg with | Alg_expr.BIN_ALG_OP (op, (m1, pos1), (m2, pos2)) -> @@ -655,7 +686,7 @@ let refine_init_t parameters error = function in error, Ast.INIT_TOK tk_l' -let refine_agent parameters error agent_set agent = +let refine_agent_sig parameters error agent_set agent = let error, agent_set = match agent with | Ast.Absent _ -> error, agent_set @@ -663,12 +694,12 @@ let refine_agent parameters error agent_set agent = check_freshness parameters error "Agent" name agent_set in let error, map = - scan_agent parameters Ckappa_sig.dummy_agent_id agent + scan_agent_sig parameters Ckappa_sig.dummy_agent_id agent (error, Ckappa_sig.Lnk_id_map_and_set.Map.empty) in let agent, (error, _map) = - translate_agent parameters true agent + translate_agent ~translate_counter:translate_counter_sig parameters true agent (error, (map, Ckappa_sig.Lnk_id_map_and_set.Set.empty)) in error, agent_set, agent @@ -699,7 +730,9 @@ let dump_rule_no_rate rule = let () = Format.pp_print_flush fmt () in Buffer.contents buf -let translate_compil parameters error compil = +let translate_compil parameters error (compil:(Ast.agent, Ast.agent_sig, Ast.mixture, Ast.agent list list, + string, Ast.rule) + Ast.compil) = let translate_rule error (rule, pos) = let (ast_lhs, ast_rhs), (prefix, tail_lhs, tail_rhs) = match rule.Ast.rewrite with @@ -770,8 +803,8 @@ let translate_compil parameters error compil = let error, _agent_set, signatures_rev = List.fold_left (fun (error, agent_set, list) agent -> - let error, agent_set, agent = - refine_agent parameters error agent_set agent + let error, agent_set, (agent:Ckappa_sig.counter_sig Ckappa_sig.parametric_agent option) = + refine_agent_sig parameters error agent_set agent in match agent with | None -> @@ -891,7 +924,7 @@ let translate_compil parameters error compil = error, Some b' in let error, o' = - bool_with_pos_with_option_map (refine_mixture parameters) error o + bool_with_pos_with_option_map (refine_mixture parameters) error o in let error, m', rules_rev' = List.fold_left diff --git a/core/KaSa_rep/frontend/prepreprocess.mli b/core/KaSa_rep/frontend/prepreprocess.mli index 175261cff..3010b5589 100644 --- a/core/KaSa_rep/frontend/prepreprocess.mli +++ b/core/KaSa_rep/frontend/prepreprocess.mli @@ -3,9 +3,10 @@ val local_trace : bool val translate_compil : Remanent_parameters_sig.parameters -> Exception_without_parameter.method_handler -> - (Ast.agent, Ast.mixture, Ast.agent list list, string, Ast.rule) Ast.compil -> + (Ast.agent, Ast.agent_sig, Ast.mixture, Ast.agent list list, string, Ast.rule) Ast.compil -> Exception_without_parameter.method_handler * ( Ckappa_sig.agent, + Ckappa_sig.agent_sig, Ckappa_sig.mixture, Ckappa_sig.mixture, string, diff --git a/core/KaSa_rep/frontend/preprocess.ml b/core/KaSa_rep/frontend/preprocess.ml index 944158123..b510f8ff5 100644 --- a/core/KaSa_rep/frontend/preprocess.ml +++ b/core/KaSa_rep/frontend/preprocess.ml @@ -185,7 +185,7 @@ let translate_agent_sig parameters error handler agent let error, (bool, output) = Ckappa_sig.Dictionary_of_sites.allocate_bool parameters error Ckappa_sig.compare_unit_site_name - (Ckappa_sig.Counter counter.Ckappa_sig.counter_name) () + (Ckappa_sig.Counter counter.Ckappa_sig.counter_sig_name) () Misc_sa.const_unit site_dic in let error, counter_name = @@ -194,19 +194,12 @@ let translate_agent_sig parameters error handler agent Exception.warn parameters error __POS__ ~message: (agent.Ckappa_sig.agent_name ^ " " - ^ counter.Ckappa_sig.counter_name) + ^ counter.Ckappa_sig.counter_sig_name) Exit Ckappa_sig.dummy_site_name | _, Some (i, _, _, _) -> error, i in let (error', c_interface), test = - let test = - match counter.Ckappa_sig.counter_test with - | Some (Ckappa_sig.CEQ i) -> [ Ckappa_sig.state_index_of_int i ] - | Some (Ckappa_sig.CGTE _) - | Some (Ckappa_sig.CVAR _) - | Some Ckappa_sig.UNKNOWN - | None -> - [] + let test = [ Ckappa_sig.state_index_of_int counter.Ckappa_sig.counter_sig_default ] in ( Ckappa_sig.Site_map_and_set.Map.add parameters error counter_name { @@ -2221,12 +2214,12 @@ let translate_c_compil parameters error handler compil = List.fold_left (fun (error, list, map) agent -> let error, ag, map = - translate_agent_sig parameters error handler agent + translate_agent_sig parameters error handler (agent:Ckappa_sig.agent_sig) Ckappa_sig.dummy_agent_id map in error, ag :: list, map) (error, [], Ckappa_sig.AgentSite_map_and_set.Map.empty) - compil.Ast.signatures + (compil.Ast.signatures:Ckappa_sig.agent_sig list) in let error, c_variables = List.fold_left diff --git a/core/KaSa_rep/frontend/preprocess.mli b/core/KaSa_rep/frontend/preprocess.mli index 8c72b6b86..4ae01f812 100644 --- a/core/KaSa_rep/frontend/preprocess.mli +++ b/core/KaSa_rep/frontend/preprocess.mli @@ -103,6 +103,7 @@ val translate_c_compil : Exception_without_parameter.method_handler -> Cckappa_sig.kappa_handler -> ( Ckappa_sig.agent, + Ckappa_sig.agent_sig, Ckappa_sig.mixture, Ckappa_sig.mixture, string, diff --git a/core/KaSa_rep/remanent_state/remanent_state.ml b/core/KaSa_rep/remanent_state/remanent_state.ml index be95f6286..cf986e4b3 100644 --- a/core/KaSa_rep/remanent_state/remanent_state.ml +++ b/core/KaSa_rep/remanent_state/remanent_state.ml @@ -21,6 +21,7 @@ type initial_state = (Primitives.alg_expr * Primitives.elementary_rule) list type refined_compilation = ( Ckappa_sig.agent, + Ckappa_sig.agent_sig, Ckappa_sig.mixture, Ckappa_sig.mixture, string, diff --git a/core/KaSa_rep/remanent_state/remanent_state.mli b/core/KaSa_rep/remanent_state/remanent_state.mli index 3ede63057..5ca251fef 100644 --- a/core/KaSa_rep/remanent_state/remanent_state.mli +++ b/core/KaSa_rep/remanent_state/remanent_state.mli @@ -43,6 +43,7 @@ type separating_transitions = Public_data.separating_transitions type refined_compilation = ( Ckappa_sig.agent, + Ckappa_sig.agent_sig, Ckappa_sig.mixture, Ckappa_sig.mixture, string, diff --git a/core/cli/cli_init.ml b/core/cli/cli_init.ml index d22d53fdf..e09334f46 100644 --- a/core/cli/cli_init.ml +++ b/core/cli/cli_init.ml @@ -30,7 +30,7 @@ type compilation_result = { } let preprocess_ast ~warning ~debug_mode ?kasim_args cli_args - (ast : (_, _, _, _, _) Ast.compil) : preprocessed_ast = + (ast : (_, _, _, _, _, _) Ast.compil) : preprocessed_ast = let () = Format.printf "+ simulation parameters@." in let conf, story_compression, formatCflow, cflowFile = Configuration.parse ast.Ast.configurations @@ -89,7 +89,7 @@ let get_ast_from_cli_args cli_args = let get_preprocessed_ast_from_cli_args ~warning ~debug_mode ?(kasim_args = Kasim_args.default) cli_args = - let ast : (Ast.agent, Ast.mixture, Ast.mixture, string, Ast.rule) Ast.compil = + let ast : (Ast.agent, Ast.agent_sig, Ast.mixture, Ast.mixture, string, Ast.rule) Ast.compil = get_ast_from_list_of_files cli_args.Run_cli_args.syntaxVersion cli_args.Run_cli_args.inputKappaFileNames in diff --git a/core/grammar/ast.ml b/core/grammar/ast.ml index 221d0e191..8f71555b5 100644 --- a/core/grammar/ast.ml +++ b/core/grammar/ast.ml @@ -38,13 +38,61 @@ type counter = { } (** Counter syntax from AST, present in 3 contexts with different meanings: agent definition, species init declaration, rule *) -type site = Port of port | Counter of counter +type counter_sig = { + counter_sig_name: string Loc.annoted; + counter_sig_min: int option Loc.annoted option ; + counter_sig_max: int option Loc.annoted option ; + counter_sig_visible: bool; + counter_sig_default: int; +} + + +let translate c = + let min,def = + match c.counter_test with + | Some (CEQ i,loc) -> (Some (Some i,loc)), i + | None | Some ((CGTE _ | CLTE _ | CVAR _),_)-> None, 0 + in + let max = + match c.counter_delta with + | i, loc -> Some (Some i,loc) + in + { + counter_sig_name = c.counter_name; + counter_sig_min = min ; + counter_sig_max = max ; + counter_sig_default = def ; + counter_sig_visible = true + } + +let op_counter_sig counter name = + { counter with counter_sig_name = name ; counter_sig_visible = false ; + counter_sig_default = + match + counter.counter_sig_max, counter.counter_sig_min + with + | Some (Some max, _), Some (Some min, _) -> + max - counter.counter_sig_default + min + | (None | Some (None, _)), _ | _, (None | Some (None, _))-> failwith "unbounded counters not implemented yet" + } + +type 'counter site = Port of port | Counter of 'counter + +let map_counters_in_site f = + function + | Port _ as x -> x + | Counter co -> Counter (f co) + type agent_mod = NoMod | Erase | Create -type agent = - | Present of string Loc.annoted * site list * agent_mod +type 'counter parametric_agent = + | Present of string Loc.annoted * 'counter site list * agent_mod | Absent of Loc.t + +type agent = counter parametric_agent +type agent_sig = counter_sig parametric_agent + (* TODO: document why list list *) type mixture = agent list list @@ -124,8 +172,8 @@ type ('pattern, 'mixture, 'id) init_statement = (* string Loc.annoted option * (*volume*)*) ('pattern, 'id) Alg_expr.e Loc.annoted * ('mixture, 'id) init_t -type ('agent, 'pattern, 'mixture, 'id, 'rule) instruction = - | SIG of 'agent +type ('agent, 'agent_id, 'pattern, 'mixture, 'id, 'rule) instruction = + | SIG of 'agent_id | TOKENSIG of string Loc.annoted | VOLSIG of string * float * string (* type, volume, parameter*) | INIT of ('pattern, 'mixture, 'id) init_statement @@ -142,12 +190,12 @@ type ('pattern, 'mixture, 'id, 'rule) command = | MODIFY of ('pattern, 'mixture, 'id, 'rule) modif_expr list | QUIT -type ('agent, 'pattern, 'mixture, 'id, 'rule) compil = { +type ('agent, 'agent_sig, 'pattern, 'mixture, 'id, 'rule) compil = { filenames: string list; variables: ('pattern, 'id) variable_def list; (** pattern declaration for reusing as variable in perturbations or kinetic rate *) - signatures: 'agent list; (** agent signature declaration *) + signatures: 'agent_sig list; (** agent signature declaration *) rules: (string Loc.annoted option * 'rule Loc.annoted) list; (** rules (possibly named): [name_option * rule_definition] *) observables: ('pattern, 'id) Alg_expr.e Loc.annoted list; @@ -160,8 +208,8 @@ type ('agent, 'pattern, 'mixture, 'id, 'rule) compil = { volumes: (string * float * string) list; } -type parsing_compil = (agent, mixture, mixture, string, rule) compil -type parsing_instruction = (agent, mixture, mixture, string, rule) instruction +type parsing_compil = (agent, agent_sig, mixture, mixture, string, rule) compil +type parsing_instruction = (agent, agent_sig, mixture, mixture, string, rule) instruction let no_more_site_on_right error left right = List.for_all @@ -252,6 +300,21 @@ let print_counter_test f = function | CLTE x, _ -> Format.fprintf f "<=%i" x | CVAR x, _ -> Format.fprintf f "=%s" x +let print_counter_min f (x,_) = + match x with + | Some x -> Format.fprintf f "=%d" x + | None -> Format.fprintf f "=-oo" + +let print_counter_max f (x,_) = + match x with + | Some x -> Format.fprintf f "/%d" x + | None -> Format.fprintf f "/+oo" + +let print_counter_default min f x = + match min with + | Some ((Some i),_) when i=x -> () + | None | Some _ -> Format.fprintf f "(%d)" x + let print_counter_delta test f (delta, _) = if delta <> 0 then Format.fprintf f "%a+=%d" @@ -265,7 +328,16 @@ let print_counter f c = (print_counter_delta c.counter_test) c.counter_delta -let print_ast_site f = function +let print_counter_sig f c = + Format.fprintf f "%s{%a%a}%a" (fst c.counter_sig_name) + (Pp.option ~with_space:false print_counter_min) + c.counter_sig_min + (Pp.option ~with_space:false print_counter_max) + c.counter_sig_max + (print_counter_default c.counter_sig_min) + c.counter_sig_default + +let print_ast_site ~print_counter f = function | Port p -> print_ast_port f p | Counter c -> print_counter f c @@ -396,6 +468,63 @@ let build_port_of_json filenames n i l = port_link_mod; } + +let site_sig_of_json filenames = function + | `Assoc [ ("counter_sig_name", n); ("counter_min", min); ("counter_max", max) ; ("counter_default", default)] + | `Assoc [ ("counter_sig_name", n); ("counter_min", min); ("counter_default", default); ("counter_max", max) ] + | `Assoc [ ("counter_sig_name", n); ("counter_max", max); ("counter_default", default); ("counter_min", min) ] + | `Assoc [ ("counter_sig_name", n); ("counter_max", max); ("counter_min", min); ("counter_default", default) ] + | `Assoc [ ("counter_sig_name", n);("counter_default", default);("counter_min", min); ("counter_max", max)] + | `Assoc [ ("counter_sig_name", n);("counter_default", default);("counter_max", max); ("counter_min", min)] + | `Assoc [ ("counter_min", min); ("counter_sig_name", n); ("counter_default", default); ("counter_max", max)] + | `Assoc [ ("counter_min", min); ("counter_sig_name", n); ("counter_max", max); ("counter_default", default)] + | `Assoc [ ("counter_min", min); ("counter_max", max); ("counter_default", default); ("counter_sig_name", n)] + | `Assoc [ ("counter_min", min); ("counter_max", max); ("counter_sig_name", n); ("counter_default", default)] + | `Assoc [ ("counter_min", min); ("counter_default", default); ("counter_max", max); ("counter_sig_name", n)] + | `Assoc [ ("counter_min", min); ("counter_default", default); ("counter_sig_name", n); ("counter_max", max)] + | `Assoc [ ("counter_max", max); ("counter_sig_name", n); ("counter_min", min); ("counter_default", default)] + | `Assoc [ ("counter_max", max); ("counter_sig_name", n); ("counter_default", default); ("counter_min", min)] + | `Assoc [ ("counter_max", max); ("counter_min", min); ("counter_sig_name", n); ("counter_default", default)] + | `Assoc [ ("counter_max", max); ("counter_min", min); ("counter_default", default); ("counter_sig_name", n)] + | `Assoc [ ("counter_max", max); ("counter_default", default); ("counter_min", min); ("counter_sig_name", n)] + | `Assoc [ ("counter_max", max); ("counter_default", default); ("counter_sig_name", n) ; ("counter_min", min)] + | `Assoc [ ("counter_default", default); ("counter_max", max); ("counter_sig_name", n); ("counter_min", min)] + | `Assoc [ ("counter_default", default); ("counter_max", max); ("counter_min", min); ("counter_sig_name", n)] + | `Assoc [ ("counter_default", default); ("counter_min", min); ("counter_sig_name", n); ("counter_max", max)] + | `Assoc [ ("counter_default", default); ("counter_min", min); ("counter_max", max); ("counter_sig_name", n)] + | `Assoc [ ("counter_default", default); ("counter_sig_name", n); ("counter_min", min); ("counter_max", max)] + | `Assoc [ ("counter_default", default); ("counter_sig_name", n); ("counter_max", max); ("counter_min", min)] + -> + Counter + { + counter_sig_name = + Loc.annoted_of_yojson ~filenames Yojson.Basic.Util.to_string n; + counter_sig_min = + Yojson.Basic.Util.to_option (Loc.annoted_of_yojson ~filenames + (Yojson.Basic.Util.to_option Yojson.Basic.Util.to_int)) min; + counter_sig_max = + Yojson.Basic.Util.to_option (Loc.annoted_of_yojson ~filenames + (Yojson.Basic.Util.to_option Yojson.Basic.Util.to_int)) max; + counter_sig_default = Yojson.Basic.Util.to_int default; + counter_sig_visible = true + } + + | `Assoc [ ("port_name", n); ("port_int", i); ("port_link", l) ] + | `Assoc [ ("port_name", n); ("port_link", l); ("port_int", i) ] + | `Assoc [ ("port_int", i); ("port_name", n); ("port_link", l) ] + | `Assoc [ ("port_link", l); ("port_name", n); ("port_int", i) ] + | `Assoc [ ("port_int", i); ("port_link", l); ("port_name", n) ] + | `Assoc [ ("port_link", l); ("port_int", i); ("port_name", n) ] -> + build_port_of_json filenames n i l + | `Assoc [ ("port_name", n); ("port_int", i) ] + | `Assoc [ ("port_int", i); ("port_name", n) ] -> + build_port_of_json filenames n i `Null + | `Assoc [ ("port_name", n); ("port_link", l) ] + | `Assoc [ ("port_link", l); ("port_name", n) ] -> + build_port_of_json filenames n `Null l + | `Assoc [ ("port_name", n) ] -> build_port_of_json filenames n `Null `Null + | x -> raise (Yojson.Basic.Util.Type_error ("Not an AST agent", x)) + let site_of_json filenames = function | `Assoc [ ("counter_name", n); ("counter_test", t); ("counter_delta", d) ] | `Assoc [ ("counter_name", n); ("counter_delta", d); ("counter_test", t) ] @@ -430,31 +559,57 @@ let site_of_json filenames = function | `Assoc [ ("port_name", n) ] -> build_port_of_json filenames n `Null `Null | x -> raise (Yojson.Basic.Util.Type_error ("Not an AST agent", x)) -let site_to_json filenames = function - | Port p -> port_to_json filenames p - | Counter c -> - `Assoc - [ - ( "counter_name", - Loc.yojson_of_annoted ~filenames JsonUtil.of_string c.counter_name ); - ( "counter_test", +let counter_to_json ~filenames c = +`Assoc + [ + ( "counter_name", + Loc.yojson_of_annoted ~filenames JsonUtil.of_string c.counter_name ); + ( "counter_test", + JsonUtil.of_option + (Loc.yojson_of_annoted ~filenames counter_test_to_json) + c.counter_test ); + ( "counter_delta", + Loc.yojson_of_annoted ~filenames JsonUtil.of_int c.counter_delta ); + ] + +let counter_sig_to_json ~filenames c = + `Assoc + [ + ( "counter_sig_name", + Loc.yojson_of_annoted ~filenames JsonUtil.of_string c.counter_sig_name ); + ( "counter_min", + JsonUtil.of_option + (Loc.yojson_of_annoted ~filenames + (JsonUtil.of_option JsonUtil.of_int)) + c.counter_sig_min) + ; + ( "counter_max", JsonUtil.of_option - (Loc.yojson_of_annoted ~filenames counter_test_to_json) - c.counter_test ); - ( "counter_delta", - Loc.yojson_of_annoted ~filenames JsonUtil.of_int c.counter_delta ); - ] + (Loc.yojson_of_annoted ~filenames + (JsonUtil.of_option JsonUtil.of_int)) + c.counter_sig_max) + ; + ( "counter_default", + JsonUtil.of_int + c.counter_sig_default) + ; + + ] + +let site_to_json ~counter_to_json filenames = function + | Port p -> port_to_json filenames p + | Counter c -> counter_to_json ~filenames c let print_agent_mod f = function | Create -> Format.pp_print_string f "+" | Erase -> Format.pp_print_string f "-" | NoMod -> Format.pp_print_string f "" -let print_ast_agent f = function +let print_ast_agent ~print_counter f = function | Absent _ -> Format.pp_print_string f "." | Present ((agent_name, _), l, m) -> Format.fprintf f "%s(%a)%a" agent_name - (Pp.list (fun f -> Format.fprintf f " ") print_ast_site) + (Pp.list (fun f -> Format.fprintf f " ") (print_ast_site ~print_counter)) l print_agent_mod m let agent_mod_to_yojson = function @@ -469,17 +624,17 @@ let agent_mod_of_yojson = function | x -> raise (Yojson.Basic.Util.Type_error ("Incorrect agent modification", x)) -let agent_to_json filenames = function +let agent_to_json ~counter_to_json ~filter filenames = function | Absent _ -> `Null | Present (na, l, m) -> JsonUtil.smart_assoc [ "name", Loc.yojson_of_annoted ~filenames JsonUtil.of_string na; - "sig", JsonUtil.of_list (site_to_json filenames) l; + "sig", JsonUtil.of_list (site_to_json ~counter_to_json filenames) (List.filter filter l); "mod", agent_mod_to_yojson m; ] -let agent_of_json filenames = function +let agent_of_json ~site_of_json filenames = function | `Null -> Absent Loc.dummy | `Assoc [ ("name", n); ("sig", s); ("mod", m) ] | `Assoc [ ("sig", s); ("name", n); ("mod", m) ] @@ -508,8 +663,16 @@ let agent_of_json filenames = function NoMod ) | x -> raise (Yojson.Basic.Util.Type_error ("Not an AST agent", x)) -let print_ast_mix = - Pp.list (fun f -> Format.fprintf f "\\@ ") (Pp.list Pp.comma print_ast_agent) +let agent_sig_of_json = agent_of_json ~site_of_json:site_sig_of_json +let agent_sig_to_json = agent_to_json ~counter_to_json:counter_sig_to_json ~filter:(fun c -> + match c with Counter c -> c.counter_sig_visible | Port _ -> true ) + +let agent_of_json = agent_of_json ~site_of_json +let agent_to_json = agent_to_json ~counter_to_json ~filter:(fun _ -> true) + + +let print_ast_mix ~print_counter = + Pp.list (fun f -> Format.fprintf f "\\@ ") (Pp.list Pp.comma (print_ast_agent ~print_counter)) let to_erased_mixture = List.map @@ -675,7 +838,7 @@ let print_tok pr_mix pr_tok pr_var f ((nb, _), (n, _)) = Format.fprintf f "%a %a" (Alg_expr.print pr_mix pr_tok pr_var) nb pr_tok n let print_one_size tk f mix = - Format.fprintf f "%a%t%a" print_ast_mix mix + Format.fprintf f "%a%t%a" (print_ast_mix ~print_counter) mix (fun f -> match tk with | [] -> () @@ -683,7 +846,7 @@ let print_one_size tk f mix = (Pp.list (fun f -> Format.pp_print_string f " + ") (print_tok - (fun f m -> Format.fprintf f "|%a|" print_ast_mix m) + (fun f m -> Format.fprintf f "|%a|" (print_ast_mix ~print_counter) m) Format.pp_print_string (fun f x -> Format.fprintf f "'%s'" x))) tk @@ -704,14 +867,14 @@ let print_raw_rate pr_mix pr_tok pr_var op f (def, _) = let print_ast_alg_expr = Alg_expr.print - (fun f m -> Format.fprintf f "|%a|" print_ast_mix m) + (fun f m -> Format.fprintf f "|%a|" (print_ast_mix ~print_counter) m) Format.pp_print_string (fun f x -> Format.fprintf f "'%s'" x) let print_rates_one_dir un f def = Format.fprintf f "%a%t" (print_raw_rate - (fun f m -> Format.fprintf f "|%a|" print_ast_mix m) + (fun f m -> Format.fprintf f "|%a|" (print_ast_mix ~print_counter) m) Format.pp_print_string (fun f x -> Format.fprintf f "'%s'" x) None) @@ -754,7 +917,7 @@ let print_configuration f ((n, _), l) = let print_init f = function | (n, _), INIT_MIX (m, _) -> Format.fprintf f "@[%%init: @[%a@]@ @[%a@]@]" print_ast_alg_expr n - print_ast_mix m + (print_ast_mix ~print_counter) m | (n, _), INIT_TOK t -> Format.fprintf f "@[%%init: %a %a@]" print_ast_alg_expr n (Pp.list Pp.space (fun f (x, _) -> Format.pp_print_string f x)) @@ -762,7 +925,7 @@ let print_init f = function let print_ast_bool_expr = Alg_expr.print_bool - (fun f m -> Format.fprintf f "|%a|" print_ast_mix m) + (fun f m -> Format.fprintf f "|%a|" (print_ast_mix ~print_counter) m) Format.pp_print_string (fun f x -> Format.fprintf f "'%s'" x) @@ -801,7 +964,7 @@ let print_modif f = function else "[false]") | CFLOWMIX (on, (p, _)) -> - Format.fprintf f "$TRACK @[%a@] %s;" print_ast_mix p + Format.fprintf f "$TRACK @[%a@] %s;" (print_ast_mix ~print_counter) p (if on then "[true]" else @@ -814,7 +977,7 @@ let print_modif f = function | Primitives.PROBABILITY -> Format.fprintf f "\"probability\" ") | DINOFF p -> Format.fprintf f "$DIN%a [false]" print_print_expr p | SPECIES_OF (on, p, (m, _)) -> - Format.fprintf f "$SPECIES_OF @[%a@] %s >%a;" print_ast_mix m + Format.fprintf f "$SPECIES_OF @[%a@] %s >%a;" (print_ast_mix ~print_counter) m (if on then "[true]" else @@ -838,7 +1001,7 @@ let print_parsing_compil_kappa f c = (Pp.list Pp.space print_configuration) c.configurations (Pp.list Pp.space (fun f a -> - Format.fprintf f "@[%%agent:@ @[%a@]@]" print_ast_agent a)) + Format.fprintf f "@[%%agent:@ @[%a@]@]" (print_ast_agent ~print_counter:print_counter_sig) a)) c.signatures (Pp.list Pp.space (fun f (s, _) -> Format.fprintf f "%%token: %s" s)) c.tokens @@ -1174,10 +1337,11 @@ let merge_internals = else y :: acc) -let rec merge_sites_counter c = function +let rec merge_sites_counter c = + function | [] -> [ Counter c ] - | Counter c' :: _ as l when fst c.counter_name = fst c'.counter_name -> l - | ((Port _ | Counter _) as h) :: t -> h :: merge_sites_counter c t + | Counter c' :: _ as l when fst c.counter_sig_name = fst c'.counter_sig_name -> l + | ((Port _ | Counter _) as h) :: t -> h :: merge_sites_counter c t let rec merge_sites_port p = function | [] -> [ Port { p with port_link = [] } ] @@ -1196,13 +1360,13 @@ let rec merge_sites_port p = function let merge_sites = List.fold_left (fun acc -> function | Port p -> merge_sites_port p acc - | Counter c -> merge_sites_counter c acc) + | Counter c -> merge_sites_counter (translate c) acc) let merge_agents = List.fold_left - (List.fold_left (fun acc -> function + (List.fold_left (fun (acc:agent_sig list) -> function | Absent _ -> acc - | Present (((na, _) as x), s, _) -> + | Present (((na, _) as x), ((s:counter site list)), _) -> let rec aux = function | [] -> [ @@ -1211,7 +1375,7 @@ let merge_agents = List.map (function | Port p -> Port { p with port_link = [] } - | Counter _ as x -> x) + | Counter _ as x -> map_counters_in_site translate x) s, NoMod ); ] @@ -1344,7 +1508,7 @@ let compil_to_json c = `Assoc [ "filenames", JsonUtil.of_array JsonUtil.of_string files; - "signatures", JsonUtil.of_list (agent_to_json filenames) c.signatures; + "signatures", JsonUtil.of_list (agent_sig_to_json filenames) c.signatures; "tokens", JsonUtil.of_list (string_annot_to_json filenames) c.tokens; ( "variables", JsonUtil.of_list @@ -1418,7 +1582,7 @@ let compil_of_json = function signatures = JsonUtil.to_list ~error_msg:(JsonUtil.build_msg "AST signature") - (agent_of_json filenames) + (agent_sig_of_json filenames) (List.assoc "signatures" l); tokens = JsonUtil.to_list @@ -1492,3 +1656,5 @@ let compil_of_json = function let write_parsing_compil b ast = Yojson.Basic.write_json b (compil_to_json ast) let read_parsing_compil p lb = compil_of_json (Yojson.Basic.read_json p lb) + +let print_ast_mix = print_ast_mix ~print_counter diff --git a/core/grammar/ast.mli b/core/grammar/ast.mli index f6358a70a..bcb376214 100644 --- a/core/grammar/ast.mli +++ b/core/grammar/ast.mli @@ -35,13 +35,26 @@ type counter = { counter_delta: int Loc.annoted; } -type site = Port of port | Counter of counter +type counter_sig = { + counter_sig_name: string Loc.annoted; + counter_sig_min: int option Loc.annoted option ; + counter_sig_max: int option Loc.annoted option ; + counter_sig_visible: bool; + counter_sig_default: int; +} + +val op_counter_sig: counter_sig -> string Loc.annoted -> counter_sig + +type 'counter site = Port of port | Counter of 'counter type agent_mod = NoMod | Erase | Create -type agent = - | Present of string Loc.annoted * site list * agent_mod +type 'counter parametric_agent = + | Present of string Loc.annoted * 'counter site list * agent_mod | Absent of Loc.t +type agent = counter parametric_agent +type agent_sig = counter_sig parametric_agent + type mixture = agent list list val mixture_to_user_graph : mixture -> User_graph.connected_component @@ -125,8 +138,8 @@ type ('mixture, 'id) init_t = type ('pattern, 'mixture, 'id) init_statement = ('pattern, 'id) Alg_expr.e Loc.annoted * ('mixture, 'id) init_t -type ('agent, 'pattern, 'mixture, 'id, 'rule) instruction = - | SIG of 'agent +type ('agent, 'agent_sig, 'pattern, 'mixture, 'id, 'rule) instruction = + | SIG of 'agent_sig | TOKENSIG of string Loc.annoted | VOLSIG of string * float * string (** type, volume, parameter *) | INIT of ('pattern, 'mixture, 'id) init_statement @@ -142,11 +155,11 @@ type ('pattern, 'mixture, 'id, 'rule) command = | MODIFY of ('pattern, 'mixture, 'id, 'rule) modif_expr list | QUIT -type ('agent, 'pattern, 'mixture, 'id, 'rule) compil = { +type ('agent, 'agent_sig, 'pattern, 'mixture, 'id, 'rule) compil = { filenames: string list; variables: ('pattern, 'id) variable_def list; (** pattern declaration for reusing as variable in perturbations or kinetic rate *) - signatures: 'agent list; (** agent signature declarations *) + signatures: 'agent_sig list; (** agent signature declarations *) rules: (string Loc.annoted option * 'rule Loc.annoted) list; (**rules (possibly named)*) observables: ('pattern, 'id) Alg_expr.e Loc.annoted list; @@ -159,11 +172,11 @@ type ('agent, 'pattern, 'mixture, 'id, 'rule) compil = { volumes: (string * float * string) list; } -type parsing_compil = (agent, mixture, mixture, string, rule) compil -type parsing_instruction = (agent, mixture, mixture, string, rule) instruction +type parsing_compil = (agent, agent_sig, mixture, mixture, string, rule) compil +type parsing_instruction = (agent, agent_sig, mixture, mixture, string, rule) instruction val empty_compil : parsing_compil -val no_more_site_on_right : bool -> site list -> site list -> bool +val no_more_site_on_right : bool -> 'a site list -> 'a site list -> bool val split_mixture : mixture -> mixture * mixture (** @return (lhs,rhs) *) diff --git a/core/grammar/counters_compiler.ml b/core/grammar/counters_compiler.ml index 9aafe0b39..3f8185c3f 100644 --- a/core/grammar/counters_compiler.ml +++ b/core/grammar/counters_compiler.ml @@ -213,23 +213,20 @@ let counters_signature s agents = (** [split_cvar_counter_in_rules_per_value var_name annot counter_delta counter_def] translates a counter CVAR whose value acts upon the rate expression into a rule per possible value, that are selected by a CEQ expression. * *) let split_cvar_counter_in_rules_per_value (var_name : string) (annot : Loc.t) - (counter_delta : int Loc.annoted) (counter_def : Ast.counter) : - (Ast.site * (string * int) list) list = - let max_value : int = Loc.v counter_def.counter_delta in - let min_value : int = - match counter_def.counter_test with - | None | Some (Ast.CGTE _, _) | Some (Ast.CLTE _, _) | Some (Ast.CVAR _, _) - -> + (counter_delta : int Loc.annoted) (counter_def : Ast.counter_sig) : + (Ast.counter Ast.site * (string * int) list) list = + let min_value, max_value = + match counter_def.counter_sig_min, counter_def.counter_sig_max with + | Some (Some min_loc, _), Some (Some max_loc, _) -> min_loc, max_loc + | (None | Some (None, _)), _ | _, (None | Some (None, _)) -> raise (ExceptionDefn.Malformed_Decl - ( "Invalid counter signature - have to specify min bound", - Loc.get_annot counter_def.counter_name )) - | Some (Ast.CEQ min_value, _) -> min_value + ( "Invalid counter signature - have to specify min/max bound", + Loc.get_annot counter_def.counter_sig_name )) in - (* Make CEQ counters with all possible values of variable *) let rec make_ceq_counters_from_var_values (value : int) : - (Ast.site * (string * int) list) list = + (Ast.counter Ast.site * (string * int) list) list = if value > max_value then [] else if @@ -238,7 +235,7 @@ let split_cvar_counter_in_rules_per_value (var_name : string) (annot : Loc.t) then ( Ast.Counter { - Ast.counter_name = counter_def.counter_name; + Ast.counter_name = counter_def.counter_sig_name; counter_test = Some (Ast.CEQ value, annot); counter_delta; }, @@ -266,7 +263,7 @@ let split_counter_variables_into_separate_rules ~warning rules signatures = let split_for_each_counter_var_value_site ids counter_defs = function | Ast.Port p -> [ Ast.Port p, [] ] | Ast.Counter c -> - let delta = Loc.v c.counter_delta in + let delta = Loc.v c.Ast.counter_delta in (match c.counter_test with | Some (Ast.CEQ value, _) -> if delta > 0 || abs delta <= value then @@ -291,10 +288,10 @@ let split_counter_variables_into_separate_rules ~warning rules signatures = [ Ast.Counter c, [] ] | Some (Ast.CVAR var_name, annot) when Mods.StringSet.mem var_name ids -> (* If the variable is present in an rate definition expression *) - let counter_def : Ast.counter = + let counter_def : Ast.counter_sig = List.find (fun counter -> - name_match c.Ast.counter_name counter.Ast.counter_name) + name_match c.Ast.counter_name counter.Ast.counter_sig_name) counter_defs in @@ -314,8 +311,9 @@ let split_counter_variables_into_separate_rules ~warning rules signatures = in let rec split_for_each_counter_var_value_sites (ids : Mods.StringSet.t) - (counter_defs : Ast.counter list) : - Ast.site list -> (Ast.site list * (string * int) list) list = function + (counter_defs : Ast.counter_sig list) : + Ast.counter Ast.site list -> + (Ast.counter Ast.site list * (string * int) list) list = function | [] -> [ [], [] ] | s :: t -> combinations_of_var_setup @@ -815,7 +813,7 @@ let compile_counter_in_rule (sigs : Signature.s) ( List.rev_map (fun rule_agent_ -> rule_agent_.agent) (List.rev mix), List.rev_map (fun raw_agent_ -> raw_agent_.agent) (List.rev created) ) -let rule_agent_with_max_counter sigs c ((agent_name, _) as agent_type) : +let rule_agent_with_max_counter sigs c ((agent_name, loc_ag) as agent_type) : LKappa.rule_mixture = let ag_id = Signature.num_of_agent agent_type sigs in let sign = Signature.get sigs ag_id in @@ -824,9 +822,18 @@ let rule_agent_with_max_counter sigs c ((agent_name, _) as agent_type) : Array.make arity (Loc.annot_with_dummy LKappa.LNK_ANY, LKappa.Maintained) in let internals = Array.make arity LKappa.I_ANY in - let c_na = c.Ast.counter_name in + let c_na = c.Ast.counter_sig_name in let c_id = Signature.num_of_site ~agent_name c_na sign in - let max_val, loc = c.Ast.counter_delta in + let max_val, loc = + match c.Ast.counter_sig_max with + | Some (Some max, loc) -> max, loc + | None | Some (None, _) -> + raise + (ExceptionDefn.Internal_Error + ( "Counter " ^ fst c_na ^ " in " ^ agent_name + ^ " should have an upper bound", + loc_ag )) + in let max_val' = max_val + 1 in let incrs = link_incr sigs 0 (max_val' + 1) ((c_id, ag_id), false) false 1 loc (-1) @@ -847,11 +854,12 @@ let rule_agent_with_max_counter sigs c ((agent_name, _) as agent_type) : ra :: incrs let counter_perturbation sigs c agent_type = - let annot = Loc.get_annot c.Ast.counter_name in + let annot = Loc.get_annot c.Ast.counter_sig_name in let filename = [ Primitives.Str_pexpr ("counter_perturbation.ka", annot) ] in let stop_message = - "Counter " ^ Loc.v c.Ast.counter_name ^ " of agent " ^ Loc.v agent_type - ^ " reached maximum" + "Counter " + ^ Loc.v c.Ast.counter_sig_name + ^ " of agent " ^ Loc.v agent_type ^ " reached maximum" in let mods = [ @@ -1024,18 +1032,12 @@ let annotate_created_counters sigs ((agent_name, _) as agent_type) counter_list Array.make arity None in - (* register all counters (specified or not) with min value *) + (* register all counters (specified or not) with default value *) Array.iteri (fun port_id _ -> match Signature.counter_of_site_id port_id agent_signature with - | Some (counter_min, counter_max) -> + | Some counter_info -> let counter_name = Signature.site_of_num port_id agent_signature in - let default_init_value = - if Signature.is_inverted_counter counter_name then - counter_max - else - counter_min - in (try (* find counter matching port *) let c : Ast.counter = @@ -1056,9 +1058,11 @@ let annotate_created_counters sigs ((agent_name, _) as agent_type) counter_list ra_counters.(port_id) <- Some ( { - Ast.counter_name = counter_name, Loc.dummy; + Ast.counter_name = counter_name |> Loc.annot_with_dummy; Ast.counter_test = - Some (Ast.CEQ default_init_value, Loc.dummy); + Some + (Ast.CEQ counter_info.counter_default_value + |> Loc.annot_with_dummy); Ast.counter_delta = 0, Loc.dummy; }, LKappa.Maintained )) diff --git a/core/grammar/counters_compiler.mli b/core/grammar/counters_compiler.mli index 66f6b5a0a..645a68718 100644 --- a/core/grammar/counters_compiler.mli +++ b/core/grammar/counters_compiler.mli @@ -38,7 +38,7 @@ val compile_counter_in_rule : val counters_perturbations : Signature.s -> - Ast.mixture -> + Ast.agent_sig list list-> (LKappa.rule_mixture, Raw_mixture.t, int, LKappa.rule) Ast.perturbation list val annotate_dropped_counters : diff --git a/core/grammar/eval.mli b/core/grammar/eval.mli index 547b83b04..ba8321a57 100644 --- a/core/grammar/eval.mli +++ b/core/grammar/eval.mli @@ -61,7 +61,7 @@ val compile : Signature.s -> unit NamedDecls.t -> Contact_map.t -> - ('c, LKappa.rule_mixture, Raw_mixture.t, int, LKappa.rule) Ast.compil -> + ('c, 'd, LKappa.rule_mixture, Raw_mixture.t, int, LKappa.rule) Ast.compil -> 'b val build_initial_state : diff --git a/core/grammar/kappaLexer.mli b/core/grammar/kappaLexer.mli index 05b5cb655..8bd6d432c 100644 --- a/core/grammar/kappaLexer.mli +++ b/core/grammar/kappaLexer.mli @@ -1,6 +1,6 @@ val compile : Format.formatter -> - (Ast.agent, Ast.mixture, Ast.mixture, string, Ast.rule) Ast.compil -> + (Ast.agent, Ast.agent_sig, Ast.mixture, Ast.mixture, string, Ast.rule) Ast.compil -> string (** file *) -> Ast.parsing_compil diff --git a/core/grammar/kappaParser.mly b/core/grammar/kappaParser.mly index c370ee69b..081e85a2c 100644 --- a/core/grammar/kappaParser.mly +++ b/core/grammar/kappaParser.mly @@ -101,7 +101,7 @@ start_rule: ; instruction: - | SIGNATURE agent_expression {Ast.SIG $2} + | SIGNATURE agent_expression_sig {Ast.SIG $2} | TOKEN ID {Ast.TOKENSIG ($2,rhs_pos 2)} | SIGNATURE error {raise (ExceptionDefn.Syntax_Error (add_pos "Malformed agent signature, I was expecting something of the form '%agent: A(x,y~u~v,z)'"))} @@ -431,6 +431,11 @@ mod_agent: | PLUS { Ast.Create } | MINUS { Ast.Erase }; +agent_expression_sig: + | ID OP_PAR interface_expression_sig CL_PAR {Ast.Present (($1,rhs_pos 1), $3, Ast.NoMod)} + | ID error { raise (ExceptionDefn.Syntax_Error + (add_pos ("Malformed agent '"^$1^"'")))} + agent_expression: | mod_agent ID OP_PAR interface_expression CL_PAR {Ast.Present (($2,rhs_pos 2), $4, $1)} @@ -439,6 +444,12 @@ agent_expression: (add_pos ("Malformed agent '"^$2^"'")))} ; +interface_expression_sig: + /*empty*/ {[]} + | port_expression_sig COMMA interface_expression_sig {$1::$3} + | port_expression_sig {[$1]} + ; + interface_expression: /*empty*/ {[]} | port_expression COMMA interface_expression {$1::$3} @@ -495,6 +506,77 @@ port_expression: Ast.counter_delta = Loc.annot_with_dummy 0} } ; +port_expression_sig: + | ID internal_state link_state_mod + { Ast.Port + {Ast.port_name=($1,rhs_pos 1); Ast.port_int=$2; Ast.port_link=[]; + Ast.port_int_mod = None; Ast.port_link_mod = $3; } } + | ID internal_state link_state link_state_mod + { Ast.Port + {Ast.port_name=($1,rhs_pos 1); Ast.port_int=$2; Ast.port_link=$3; + Ast.port_int_mod = None; Ast.port_link_mod = $4; } } + | ID internal_state DIV KAPPA_MRK link_state_mod + { Ast.Port + {Ast.port_name=($1,rhs_pos 1); Ast.port_int=$2; Ast.port_link=[]; + Ast.port_int_mod = Some($4,rhs_pos 4); Ast.port_link_mod = $5; } } + | ID internal_state DIV KAPPA_MRK link_state link_state_mod + { Ast.Port + {Ast.port_name=($1,rhs_pos 1); Ast.port_int=$2; Ast.port_link=$5; + Ast.port_int_mod = Some($4,rhs_pos 4); Ast.port_link_mod = $6; } } + | ID PLUS EQUAL INT + { Ast.Counter + { Ast.counter_sig_name = ($1,rhs_pos 1); + Ast.counter_sig_min = None; + Ast.counter_sig_max = Some (Some $4, rhs_pos 4); + Ast.counter_sig_default = $4; + Ast.counter_sig_visible = true}} + | ID PLUS EQUAL MINUS INT + {Ast.Counter + { Ast.counter_sig_name = ($1,rhs_pos 1); + Ast.counter_sig_min = None; + Ast.counter_sig_max = Some (Some (-$5), rhs_pos 5); + Ast.counter_sig_default = -$5; + Ast.counter_sig_visible = true}} + | ID counter_test PLUS EQUAL INT + { let min = + match $2 with + | Some (Ast.CEQ i,_) -> i + | None | Some ((CGTE _|CLTE _|CVAR _), _) -> raise (ExceptionDefn.Syntax_Error + (add_pos "Issue counters in signature")) + in Ast.Counter + { Ast.counter_sig_name = ($1,rhs_pos 1); + Ast.counter_sig_min = Some (Some min, rhs_pos 2); + Ast.counter_sig_max = Some (Some $5, rhs_pos 5); + Ast.counter_sig_default = min; + Ast.counter_sig_visible = true}} + | ID counter_test PLUS EQUAL MINUS INT + { let min = + match $2 with + | Some (Ast.CEQ i,_) -> i + | None | Some ((CGTE _|CLTE _|CVAR _), _) -> raise (ExceptionDefn.Syntax_Error + (add_pos "Issue counters in signature")) + in + Ast.Counter + { Ast.counter_sig_name = ($1,rhs_pos 1); + Ast.counter_sig_min = Some (Some min, rhs_pos 2); + Ast.counter_sig_max = Some (Some (-$6), rhs_pos 6); + Ast.counter_sig_default = min ; + Ast.counter_sig_visible = true}} + | ID counter_test + { let min = + match $2 with + | Some (Ast.CEQ i,_) -> i + | None | Some ((CGTE _|CLTE _|CVAR _), _) -> raise (ExceptionDefn.Syntax_Error + (add_pos "Issue counters in signature")) + in + Ast.Counter + { Ast.counter_sig_name = ($1,rhs_pos 1); + Ast.counter_sig_min = Some (Some min, rhs_pos 2); + Ast.counter_sig_max = None; + Ast.counter_sig_default = min; + Ast.counter_sig_visible = true}} + + internal_state: /*empty*/ {[]} | KAPPA_MRK internal_state {(Some $1,rhs_pos 1)::$2} diff --git a/core/grammar/klexer4.mli b/core/grammar/klexer4.mli index 45b3d89d7..fd814da56 100644 --- a/core/grammar/klexer4.mli +++ b/core/grammar/klexer4.mli @@ -3,7 +3,7 @@ val model : val compile : Format.formatter -> - (Ast.agent, Ast.mixture, Ast.mixture, string, Ast.rule) Ast.compil -> + (Ast.agent, Ast.agent_sig, Ast.mixture, Ast.mixture, string, Ast.rule) Ast.compil -> string -> Ast.parsing_compil diff --git a/core/grammar/kparser4.mly b/core/grammar/kparser4.mly index 3bed553a1..3c40f6e1d 100644 --- a/core/grammar/kparser4.mly +++ b/core/grammar/kparser4.mly @@ -140,6 +140,54 @@ site_counter: { (Some $1,$5) } ; +site_counter_sig: + | EQUAL annoted INT annoted DIV annoted counter_modif annoted CL_CUR annoted + { Some (Some ($3),rhs_pos 3),match $7 with (a,loc) -> Some (Some (a),loc) } + | EQUAL annoted INT annoted CL_CUR annoted + { Some (Some ($3),rhs_pos 3),None } + ; + + site_sig: + | ID annoted OP_BRA site_link annoted OP_CUR annoted site_internal annoted + { let (port_link, port_link_mod) = $4 in + let (port_int, port_int_mod) = $8 in + Ast.Port + { Ast.port_name=($1,rhs_pos 1); Ast.port_int; + Ast.port_link; Ast.port_int_mod; Ast.port_link_mod; } } + | ID annoted OP_CUR annoted site_internal annoted OP_BRA site_link annoted + { let (port_int, port_int_mod) = $5 in + let (port_link, port_link_mod) = $8 in + Ast.Port + { Ast.port_name=($1,rhs_pos 1); Ast.port_int; + Ast.port_link; Ast.port_int_mod; Ast.port_link_mod; } } + | ID annoted OP_BRA site_link annoted + { let (port_link, port_link_mod) = $4 in + Ast.Port + { Ast.port_name=($1,rhs_pos 1); Ast.port_int=[]; + Ast.port_link; Ast.port_int_mod=None; Ast.port_link_mod; } } + | ID annoted OP_CUR annoted site_internal annoted + { let (port_int, port_int_mod) = $5 in + Ast.Port + { Ast.port_name=($1,rhs_pos 1);Ast.port_link=[]; + Ast.port_int; Ast.port_int_mod; Ast.port_link_mod=None; } } + | ID annoted OP_CUR annoted site_counter_sig + { let (counter_sig_min,counter_sig_max) = $5 in + Ast.Counter + { Ast.counter_sig_name=($1,rhs_pos 1); + Ast.counter_sig_min; + Ast.counter_sig_max; + Ast.counter_sig_default= + (match counter_sig_min with + | None | Some (None, _)-> 0 + | Some (Some i,_) -> i ); + Ast.counter_sig_visible=true; + } } + | ID annoted + { Ast.Port + { Ast.port_name=($1,rhs_pos 1);Ast.port_link=[]; Ast.port_int=[]; + Ast.port_int_mod=None; Ast.port_link_mod=None; } } + ; + site: | ID annoted OP_BRA site_link annoted OP_CUR annoted site_internal annoted { let (port_link, port_link_mod) = $4 in @@ -182,6 +230,15 @@ interface: | site COMMA annoted interface { $1 :: $4 } ; +interface_sig: + | { [] } + | error + { raise (ExceptionDefn.Syntax_Error + (add_pos 1 ("Malformed site expression"))) } + | site_sig interface_sig { $1 :: $2 } + | site_sig COMMA annoted interface_sig { $1 :: $4 } + ; + agent_modif: | annoted { Ast.NoMod,start_pos 1,$1 } | annoted PLUS annoted { Ast.Create,end_pos 2,$3 } @@ -201,6 +258,18 @@ agent: (add_pos 3 ("Malformed agent '"^$1^"'"))) } ; +agent_sig: + | DOT annoted { (Ast.Absent (rhs_pos 1),end_pos 1,$2) } + | ID annoted OP_PAR annoted interface_sig CL_PAR agent_modif + { let modif,pend,an = $7 in + (Ast.Present (($1,rhs_pos 1), $5, modif),pend,an) } + | ID annoted COLON annoted ID annoted OP_PAR annoted interface_sig CL_PAR agent_modif + { let modif,pend,an = $11 in + (Ast.Present (($5,rhs_pos 5), $9, modif),pend,an) } + | ID annoted error + { raise (ExceptionDefn.Syntax_Error + (add_pos 3 ("Malformed agent '"^$1^"'"))) } + ; pattern: | agent COMMA annoted pattern { let (x,_,_) = $1 in @@ -708,7 +777,7 @@ sentence: | LABEL annoted EQUAL annoted alg_expr { let (v,_,_) = $5 in add (Ast.DECLARE (($1,rhs_pos 1),v)) } | rule { add (Ast.RULE (None,$1)) } - | SIGNATURE annoted agent { let (a,_,_) = $3 in add (Ast.SIG a) } + | SIGNATURE annoted agent_sig { let (a,_,_) = $3 in add (Ast.SIG a) } | SIGNATURE annoted error { raise (ExceptionDefn.Syntax_Error (add_pos 3 "Malformed agent signature")) } diff --git a/core/grammar/lKappa_compiler.ml b/core/grammar/lKappa_compiler.ml index 48bed3f56..78b9c2503 100644 --- a/core/grammar/lKappa_compiler.ml +++ b/core/grammar/lKappa_compiler.ml @@ -1616,7 +1616,7 @@ type site_sig_with_links_as_lists = (** Temporary type to store site signature with list links instead of array array links *) (** [prepare_agent_sig ~sites evaluates to (site_sigs, counter_list) which describe data that can be used to create a Signature.t for a single agent*) -let prepare_agent_sig ~(sites : Ast.site list) : +let prepare_agent_sig ~(sites : Ast.counter_sig Ast.site list) : site_sig_with_links_as_lists NamedDecls.t * string Loc.annoted list = let ( (site_sigs_pre_nameddecls : (string Loc.annoted * site_sig_with_links_as_lists) list), @@ -1661,28 +1661,7 @@ let prepare_agent_sig ~(sites : Ast.site list) : acc_counter_names ) | Counter c -> (* We are reading here a signature, only CEQ tests are accepted *) - (match c.counter_test with - | None -> - let n, pos = c.counter_name in - raise - (ExceptionDefn.Internal_Error - ("Counter " ^ n ^ " should have a test in signature", pos)) - | Some (test, pos) -> - (match test with - | CVAR _ -> - raise - (ExceptionDefn.Internal_Error - ("Counter should not have a var in signature", pos)) - | CGTE _ -> - raise - (ExceptionDefn.Internal_Error - ("Counter should not have >= in signature", pos)) - | CLTE _ -> - raise - (ExceptionDefn.Internal_Error - ("Counter should not have <= in signature", pos)) - | CEQ j -> - ( ( c.counter_name, + ( ( ( c.Ast.counter_sig_name, { internal_state = NamedDecls.create [||]; (* Agent with counter can link to port [b] on counter agent [__counter_agent] *) @@ -1692,10 +1671,21 @@ let prepare_agent_sig ~(sites : Ast.site list) : ( Loc.annot_with_dummy "b", Loc.annot_with_dummy "__counter_agent" ); ]; - counters_info = Some (j, Loc.v c.counter_delta); - } ) + counters_info = Some ( + {counter_info_min= + (match c.Ast.counter_sig_min with + | Some (Some i,_) -> Some i + | None | Some (None,_) -> None); + counter_info_max= + (match c.Ast.counter_sig_max with + | Some (Some i,_) -> Some i + | None | Some (None,_) -> None); + + counter_default_value=c.Ast.counter_sig_default; + + } )}) :: acc_site_sigs, - c.counter_name :: acc_counter_names )))) + c.counter_sig_name :: acc_counter_names ))) sites ([], []) in NamedDecls.create_from_list site_sigs_pre_nameddecls, counter_names @@ -1799,7 +1789,7 @@ let agent_sigs_of_agent_sigs_with_links_as_lists ~(build_contact_map : bool) ))) agent_sigs_pre -let create_sigs (l : Ast.agent list) : Signature.s = +let create_sigs (l : Ast.agent_sig list) : Signature.s = (* Contact map should be built only if a specific link is described in the definition of signature *) let build_contact_map : bool = List.fold_left @@ -1877,7 +1867,7 @@ type ast_compiled_data = { alg_vars_finder: int Mods.StringMap.t; updated_alg_vars: int list; result: - (Ast.agent, LKappa.rule_mixture, Raw_mixture.t, int, LKappa.rule) Ast.compil; + (Ast.agent, Ast.agent_sig, LKappa.rule_mixture, Raw_mixture.t, int, LKappa.rule) Ast.compil; (** Compiled data where identifiers are i Ast.compil where identifiers * are integers and not string, syntactic sugar on rules are expansed * (syntactic sugar on mixture are not) *) @@ -1945,7 +1935,7 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = in (* Create opposite counters that have the same tests *) - let signatures : Ast.agent list = + let signatures : Ast.agent_sig list = List.map (fun agent -> match agent with @@ -1959,17 +1949,17 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = agent_name = agent_name_counter) counters_with_clte_tests in - let new_counter_sites : Ast.site list = + let new_counter_sites : Ast.counter_sig Ast.site list = List.fold_left (fun acc (_, counter_name, sum_bounds_ref) -> (* Find counter to invert *) - let counter_orig : Ast.counter = + let counter_orig : Ast.counter_sig = List.find_map (fun site -> match site with | Ast.Port _ -> None | Counter counter -> - if Loc.v counter.counter_name = counter_name then + if Loc.v counter.Ast.counter_sig_name = counter_name then Some counter else None) @@ -1978,31 +1968,36 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = in (* Make inverted counter declaration *) - let counter_name : string Loc.annoted = + let counter_sig_name : string Loc.annoted = Loc.map_annot (fun name -> inverted_counter_name name) - counter_orig.counter_name + counter_orig.counter_sig_name in - let counter_test = counter_orig.counter_test in - let counter_delta = counter_orig.counter_delta in - - (* Write in sum_bounds_ref the sum of the counter bounds above *) - let inf_bound = - match - counter_test |> Option_util.unsome_or_raise |> Loc.v - with - | CGTE _ | CLTE _ | CVAR _ -> + let counter_sig_min = counter_orig.counter_sig_min in + let counter_sig_max = counter_orig.counter_sig_max in + let counter_sig_default, inf_bound, sup_bound = + match counter_sig_min, counter_sig_max with + | Some (Some min,_), Some (Some max,_) -> + max + min - counter_orig.counter_sig_default, min, max + | (None | (Some (None,_))),_ + | _, (None | (Some (None,_))) -> raise - (ExceptionDefn.Malformed_Decl - ( "Counter should have CEQ test value in signature \ - statement", - Loc.get_annot counter_name )) - | CEQ value -> value + (ExceptionDefn.Malformed_Decl + ( "Cannot take the opposite of an unbounded counters \ ", + Loc.get_annot counter_orig.counter_sig_name )); + in - let sup_bound = Loc.v counter_delta in + let counter_sig_visible = false in + (* Write in sum_bounds_ref the sum of the counter bounds above *) sum_bounds_ref := inf_bound + sup_bound; - Ast.Counter { counter_name; counter_test; counter_delta } :: acc) + Ast.Counter { + Ast.counter_sig_name; + Ast.counter_sig_min; + Ast.counter_sig_max; + Ast.counter_sig_default; + Ast.counter_sig_visible}::acc) + [] counters_with_clte_tests_from_agent in @@ -2029,7 +2024,7 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = in (* Add delta to counter as opposite deltas to counter_delta *) let (added_sites, site_list_with_opposite_deltas) : - Ast.site list * Ast.site list = + Ast.counter Ast.site list * Ast.counter Ast.site list = List.fold_left_map (fun acc site -> match site with @@ -2038,7 +2033,7 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = (match List.find_opt (fun (_, name, _) -> - String.equal (Loc.v counter.counter_name) name) + String.equal (Loc.v counter.Ast.counter_name) name) counters_with_clte_tests_from_agent with | None -> acc, site @@ -2063,11 +2058,11 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = let inverted_counter_site = Ast.Counter { - counter_name = + Ast.counter_name = Loc.map_annot inverted_counter_name counter.counter_name; - counter_test = None; - counter_delta = + Ast.counter_test = None; + Ast.counter_delta = Loc.map_annot (fun delta -> -delta) counter.counter_delta; @@ -2082,16 +2077,16 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = let new_site = Ast.Counter { - counter_name = + Ast.counter_name = Loc.map_annot inverted_counter_name counter.counter_name; - counter_test = + Ast.counter_test = Some (Ast.CGTE (!sum_bounds_ref - value) |> Loc.copy_annot (Option_util.unsome_or_raise counter.counter_test)); - counter_delta = + Ast.counter_delta = Loc.map_annot (fun delta -> -delta) counter.counter_delta; @@ -2108,7 +2103,7 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = )))) [] site_list in - let new_site_list : Ast.site list = + let new_site_list : Ast.counter Ast.site list = site_list_with_opposite_deltas @ added_sites in Ast.Present (agent_name_, new_site_list, agent_mod)) @@ -2156,7 +2151,7 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = counters_with_clte_tests in (* Add delta to counter as opposite deltas to counter_delta *) - let added_sites : Ast.site list = + let added_sites : Ast.counter Ast.site list = List.fold_left (fun acc site -> match site with @@ -2165,7 +2160,7 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = (match List.find_opt (fun (_, name, _) -> - String.equal (Loc.v counter.counter_name) name) + String.equal (Loc.v counter.Ast.counter_name) name) counters_with_clte_tests_from_agent with | None -> acc @@ -2196,21 +2191,21 @@ let translate_clte_into_cgte (ast_compil : Ast.parsing_compil) = else Ast.Counter { - counter_name = + Ast.counter_name = Loc.map_annot inverted_counter_name - counter.counter_name; - counter_test = + counter.Ast.counter_name; + Ast.counter_test = Some (Loc.copy_annot test (Ast.CEQ (!sum_bounds_ref - value))); - counter_delta = - counter.counter_delta + Ast.counter_delta = + counter.Ast.counter_delta (* 0 with annot as tested above *); } :: acc)))) [] site_list in - let new_site_list : Ast.site list = site_list @ added_sites in + let new_site_list : Ast.counter Ast.site list = site_list @ added_sites in Ast.Present (agent_name_, new_site_list, agent_mod)) agent_list) mix diff --git a/core/grammar/lKappa_compiler.mli b/core/grammar/lKappa_compiler.mli index 2bda34161..71fe4cb31 100644 --- a/core/grammar/lKappa_compiler.mli +++ b/core/grammar/lKappa_compiler.mli @@ -46,6 +46,7 @@ type ast_compiled_data = { updated_alg_vars: int list; (** alg vars with forbidden constant prop *) result: ( Ast.agent, + Ast.agent_sig, LKappa.rule_agent list, Raw_mixture.t, int, diff --git a/core/siteGraphs/signature.ml b/core/siteGraphs/signature.ml index 1230c298a..602d1eb4e 100644 --- a/core/siteGraphs/signature.ml +++ b/core/siteGraphs/signature.ml @@ -6,11 +6,17 @@ (* |_|\_\ * GNU Lesser General Public License Version 3 *) (******************************************************************************) +type counter_info = + { + counter_info_min: int option; + counter_info_max: int option; + counter_default_value: int + } + type 'links site_sig = { internal_state: unit NamedDecls.t; links: 'links option; - counters_info: (int * int) option; - (** If relevant: counter CEQ value * counter delta *) + counters_info: counter_info option; } type t = bool array array site_sig NamedDecls.t @@ -86,7 +92,7 @@ let one_to_json = signature.links ); ( "counters_info", JsonUtil.of_option - (fun (c1, c2) -> `List [ `Int c1; `Int c2 ]) + (fun c -> `Assoc [ "min", JsonUtil.of_option (fun x -> `Int x) c.counter_info_min; "max", JsonUtil.of_option (fun x -> `Int x) c.counter_info_max; "default", `Int c.counter_default_value;]) signature.counters_info ); ]) @@ -131,7 +137,24 @@ let one_of_json : Yojson.Basic.t -> bool array array site_sig NamedDecls.t = counters_info = Yojson.Basic.Util.to_option (function - | `List [ `Int c1; `Int c2 ] -> c1, c2 + | `Assoc [ "min", c1_opt; "max", c2_opt; "default", `Int c3] -> + { + counter_info_min = Yojson.Basic.Util.to_option + (function + | `Int c -> c + | x -> + raise + (Yojson.Basic.Util.Type_error + ("Problematic agent signature", x))) c1_opt ; + counter_info_max = Yojson.Basic.Util.to_option + (function + | `Int c -> c + | x -> + raise + (Yojson.Basic.Util.Type_error + ("Problematic agent signature", x))) c2_opt ; + counter_default_value = c3 + } | x -> raise (Yojson.Basic.Util.Type_error @@ -257,10 +280,20 @@ let print_site_internal_state sigs ag_ty site f = function (site_of_id ag_ty site sigs) (internal_state_of_id ag_ty site id sigs) -let print_counter sigs ag_ty f id = - match counter_of_site_id id (get sigs ag_ty) with +let pp_counts f = function | None -> () - | Some (c1, c2) -> Format.fprintf f "{=%d/+=%d}" c1 c2 + | Some c -> + match c.counter_info_min, c.counter_info_max with + | Some i, Some j when i=c.counter_default_value -> + Format.fprintf f "{=%d/+=%d}" i j + | i_opt, j_opt -> + Format.fprintf f "{-=%s/=%d/+=%s}" + (match i_opt with None -> "-oo" | Some i -> Format.sprintf "%d" i) + c.counter_default_value + (match j_opt with None -> "-oo" | Some i -> Format.sprintf "%d" i) + +let print_counter sigs ag_ty f id = + pp_counts f (counter_of_site_id id (get sigs ag_ty)) let print_one ?(sigs : s option) (i : int) (f : Format.formatter) (signature : t) = @@ -287,10 +320,6 @@ let print_one ?(sigs : s option) (i : int) (f : Format.formatter) si (print_agent sigs) (i + ag)))) links) in - let pp_counts f = function - | None -> () - | Some (c1, c2) -> Format.fprintf f "{=%d/+=%d}" c1 c2 - in (NamedDecls.print ~sep:(fun f -> Format.fprintf f ",@,") (fun _ name f site_sig -> diff --git a/core/siteGraphs/signature.mli b/core/siteGraphs/signature.mli index 57400ec8a..7edeb1892 100644 --- a/core/siteGraphs/signature.mli +++ b/core/siteGraphs/signature.mli @@ -12,10 +12,18 @@ (* TODO document what is internal state *) (* TODO *) + +type counter_info = + { + counter_info_min: int option; + counter_info_max: int option; + counter_default_value: int + } + type 'links site_sig = { internal_state: unit NamedDecls.t; links: 'links option; - counters_info: (int * int) option; + counters_info: counter_info option; (** If relevant: counter CEQ value * counter delta *) } @@ -33,7 +41,7 @@ val num_of_internal_state : int -> string Loc.annoted -> t -> int val internal_state_of_site_id : int -> int -> t -> string (**[internal_state_of_site_id site_id value_id signature] *) -val counter_of_site_id : int -> t -> (int * int) option +val counter_of_site_id : int -> t -> counter_info option val has_counter : t -> bool type s diff --git a/tests/integration/compiler/counters_smaller_than/output/inputs.ka.ref b/tests/integration/compiler/counters_smaller_than/output/inputs.ka.ref index 836df5b98..930501e74 100644 --- a/tests/integration/compiler/counters_smaller_than/output/inputs.ka.ref +++ b/tests/integration/compiler/counters_smaller_than/output/inputs.ka.ref @@ -7,7 +7,7 @@ %def: "outputFileName" "data.csv" -%agent: A(c{=0/+=7} c__inverted{=0/+=7}) +%agent: A(c{=0/+=7} c__inverted{-=0/=7/+=7}) %agent: B() %var:/*0*/ 'B' |B()| diff --git a/tests/integration/compiler/counters_smaller_than_default/output/error.log.ref b/tests/integration/compiler/counters_smaller_than_default/output/error.log.ref index 28429451b..7e80168fc 100644 --- a/tests/integration/compiler/counters_smaller_than_default/output/error.log.ref +++ b/tests/integration/compiler/counters_smaller_than_default/output/error.log.ref @@ -8,7 +8,7 @@ _____(1) A(c{>=8}) Environment: - %agent: A(c{=0/+=7} c__inverted{=0/+=7}) + %agent: A(c{=0/+=7} c__inverted{-=0/=7/+=7}) %plot: [T] A(c{=0} c__inverted{=7})+ @ 1 diff --git a/tests/integration/compiler/site_mismatch/output/LOG.ref b/tests/integration/compiler/site_mismatch/output/LOG.ref index 28c6fc2ce..fd8f89aa7 100644 --- a/tests/integration/compiler/site_mismatch/output/LOG.ref +++ b/tests/integration/compiler/site_mismatch/output/LOG.ref @@ -73,4 +73,4 @@ every agent may occur in the model ------------------------------------------------------------ Some exceptions have been raised -error: file_name: core/KaSa_rep/frontend/prepreprocess.ml; message: line 719, File "crash.ka", line 4, characters 5-69:: missaligned rule: the rule is ignored; exception:Exit +error: file_name: core/KaSa_rep/frontend/prepreprocess.ml; message: line 752, File "crash.ka", line 4, characters 5-69:: missaligned rule: the rule is ignored; exception:Exit diff --git a/tests/integration/simulation/counters_create/output/inputs.ka.ref b/tests/integration/simulation/counters_create/output/inputs.ka.ref index 77f12712a..27872027f 100644 --- a/tests/integration/simulation/counters_create/output/inputs.ka.ref +++ b/tests/integration/simulation/counters_create/output/inputs.ka.ref @@ -7,7 +7,7 @@ %def: "outputFileName" "data.svg" -%agent: A(c{=0/+=10} c__inverted{=0/+=10}) +%agent: A(c{=0/+=10} c__inverted{-=0/=10/+=10}) %agent: B() %var:/*0*/ 'B' |B()|