Skip to content

Commit

Permalink
Refactor Signature.mli and logic to build them
Browse files Browse the repository at this point in the history
  • Loading branch information
gikiam committed Nov 8, 2023
1 parent 683a9af commit 5cf07b4
Show file tree
Hide file tree
Showing 25 changed files with 597 additions and 404 deletions.
18 changes: 14 additions & 4 deletions core/KaSa_rep/export/export.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1729,17 +1729,27 @@ functor
states)
in
( state,
(Locality.annotate_with_dummy x, (states', binding', None))
( Locality.annotate_with_dummy x,
{
Signature.internal_state = states';
links = Some binding';
counters_info = None;
} )
:: acc ))
(state, []) interface
in
( state,
( Locality.annotate_with_dummy a,
NamedDecls.create (Array.of_list acc) )
(Locality.annotate_with_dummy a, NamedDecls.create_from_list acc)
:: list ))
(state, []) l.(0)
in
let signature = Signature.create ~counters:[] true l in
let agent_sigs =
LKappa_compiler.agent_sigs_of_agent_sigs_with_links_as_lists
~build_contact_map:true
(NamedDecls.create_from_list l)
in
let signature = Signature.create ~counters:[] agent_sigs in
Remanent_state.set_signature signature state, signature
let get_signature = get_gen Remanent_state.get_signature compute_signature
Expand Down
2 changes: 1 addition & 1 deletion core/api/dune
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@
(name kappa_json_api)
(libraries atdgen-runtime lwt
kappa_grammar kappa_kasa_type_interface kappa_cflow)
(flags (:standard -w +a
(flags (:standard -w +a-40-42
-open Kappa_generic_toolset
-open Kappa_mixtures
-open Kappa_terms
Expand Down
9 changes: 5 additions & 4 deletions core/cli/cli_init.ml
Original file line number Diff line number Diff line change
Expand Up @@ -75,13 +75,13 @@ let preprocess_ast ~warning ~debug_mode ?kasim_args cli_args
overwrite_t0;
}

let get_ast_from_list_of_files syntax_version list =
let f =
let get_ast_from_list_of_files syntax_version file_list =
let compiling_function =
match syntax_version with
| Ast.V4 -> Klexer4.compile Format.std_formatter
| Ast.V3 -> KappaLexer.compile Format.std_formatter
in
List.fold_left f Ast.empty_compil list
List.fold_left compiling_function Ast.empty_compil file_list

let get_ast_from_cli_args cli_args =
get_ast_from_list_of_files cli_args.Run_cli_args.syntaxVersion
Expand Down Expand Up @@ -270,7 +270,8 @@ let get_compilation ~warning ~debug_mode ?(compile_mode_on = false)
let preprocessed_ast =
get_preprocessed_ast_from_cli_args ~warning ~debug_mode cli_args
in
get_pack_from_preprocessed_ast kasim_args ~compile_mode_on preprocessed_ast
get_pack_from_preprocessed_ast kasim_args ~compile_mode_on
preprocessed_ast
| marshalized_file ->
get_pack_from_marshalizedfile ~warning kasim_args cli_args
marshalized_file
Expand Down
6 changes: 3 additions & 3 deletions core/cli/dune
Original file line number Diff line number Diff line change
Expand Up @@ -8,8 +8,8 @@
kappa-library.runtime kappa_version)
(flags (:standard -w @a-40-42
-open Kappa_version
-open Kappa_generic_toolset
-open Kappa_generic_toolset
-open Kappa_mixtures
-open Kappa_terms
-open Kappa_grammar
-open Kappa_runtime)))
-open Kappa_grammar
-open Kappa_runtime)))
3 changes: 3 additions & 0 deletions core/dataStructures/locality.ml
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,9 @@ type position = { chr: int; line: int }
type t = { file: string; from_position: position; to_position: position }
type 'a annoted = 'a * t

let v (v, _) = v
let get_annot (_, annot) = annot

let of_pos start_location end_location =
let () =
assert (start_location.Lexing.pos_fname = end_location.Lexing.pos_fname)
Expand Down
6 changes: 6 additions & 0 deletions core/dataStructures/locality.mli
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,12 @@ type position = { chr: int; line: int }
type t = { file: string; from_position: position; to_position: position }
type 'a annoted = 'a * t

val v : 'a annoted -> 'a
(** Extract value from Locality.annoted *)

val get_annot : 'a annoted -> t
(** Extract annotation from Locality.annoted *)

val of_pos : Lexing.position -> Lexing.position -> t
val dummy : t
val annotate_with_dummy : 'a -> 'a annoted
Expand Down
11 changes: 11 additions & 0 deletions core/dataStructures/namedDecls.ml
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,12 @@ let create ?forbidden a =
finder = name_map_of_array ?forbidden a;
}

let create_from_list ?forbidden l = create ?forbidden (Array.of_list l)

(* TODO see if we should keep this *)
let create_no_loc ?forbidden a =
Array.map (fun (x, y) -> (x, Locality.dummy), y) a |> create ?forbidden

let size nd = Array.length nd.decls
let elt_name nd i = fst nd.decls.(i)

Expand All @@ -52,12 +58,17 @@ let debug_print pr f nd =
let fold f acc nd =
Tools.array_fold_lefti (fun i acc (na, x) -> f i na acc x) acc nd.decls

let map f nd =
{ decls = Array.map (fun (s, v) -> s, f s v) nd.decls; finder = nd.finder }

let mapi f nd =
{
decls = Array.mapi (fun i (s, v) -> s, f i s v) nd.decls;
finder = nd.finder;
}

let elt_val nd i = snd nd.decls.(i)

let to_json aux nd =
`List
(Array.fold_right
Expand Down
18 changes: 18 additions & 0 deletions core/dataStructures/namedDecls.mli
Original file line number Diff line number Diff line change
Expand Up @@ -16,11 +16,29 @@ type 'a t = private {

val create :
?forbidden:Mods.StringSet.t -> (string Locality.annoted * 'a) array -> 'a t
(** [create ~forbidden string_val_assoc] evaluates to a namedDecls.t from the string-to-variable associations [string_val_assoc] except from strings in [forbidden]. Locality info is not kept. *)
(* TODO should we remove Locality info *)

val create_from_list :
?forbidden:Mods.StringSet.t -> (string Locality.annoted * 'a) list -> 'a t

(* TODO see if better name, what implementation is to be kept *)
val create_no_loc : ?forbidden:Mods.StringSet.t -> (string * 'a) array -> 'a t
(** [create_no_loc] behaves the same as [create], but without the need to provide the Locality info that will be trashed *)

val size : 'a t -> int

val elt_name : 'a t -> int -> string
(** [elt_name nd i] evaluates to the name declaration of id [i] in [nd], or raises an exception if it doesn't exist *)

val elt_id : ?kind:string -> 'a t -> string Locality.annoted -> int
(** [elt_id ~kind nd (s, pos)] evaluates to the data matching declaration [s] in [nd], or if it doesn't exist, throw and exception with info about [kind] and [pos] *)

val elt_val : 'a t -> int -> 'a
(** Access data by id *)

val fold : (int -> string -> 'a -> 'b -> 'a) -> 'a -> 'b t -> 'a
val map : (string -> 'a -> 'b) -> 'a t -> 'b t
val mapi : (int -> string -> 'a -> 'b) -> 'a t -> 'b t

val print :
Expand Down
4 changes: 4 additions & 0 deletions core/dataStructures/option_util.ml
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,10 @@ let unsome default = function
| None -> default
| Some a -> a

let unsome_or_raise = function
| None -> raise (Invalid_argument "unsome_or_raise was passed a None")
| Some a -> a

let map f = function
| Some x -> Some (f x)
| None -> None
Expand Down
1 change: 1 addition & 0 deletions core/dataStructures/option_util.mli
Original file line number Diff line number Diff line change
Expand Up @@ -12,4 +12,5 @@ val map : ('a -> 'b) -> 'a option -> 'b option
val fold : ('a -> 'b -> 'a) -> 'a -> 'b option -> 'a
val bind : ('a -> 'b option) -> 'a option -> 'b option
val unsome : 'a -> 'a option -> 'a
val unsome_or_raise : 'a option -> 'a
val equal : ('a -> 'a -> bool) -> 'a option -> 'a option -> bool
16 changes: 8 additions & 8 deletions core/dataStructures/setMap.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1150,14 +1150,14 @@ module Make (Ord : OrderedType) : S with type elt = Ord.t = struct
Some key
)

(* let rec find_acc k m = *)
(* match m with *)
(* Private.Empty -> None *)
(* | Private.Node (l, key, r, _, _) -> *)
(* let s = size l in *)
(* if k < s then find_acc k l *)
(* else if k = s then Some key *)
(* else find_acc (k - s - 1) r *)
(* let rec find_acc k m =
match m with
| Private.Empty -> None
| Private.Node (l, key, r, _, _) ->
let s = size l in
if k < s then find_acc k l
else if k = s then Some key
else find_acc (k - s - 1) r *)

let random rs m =
let s = size m in
Expand Down
59 changes: 39 additions & 20 deletions core/grammar/ast.ml
Original file line number Diff line number Diff line change
Expand Up @@ -44,16 +44,19 @@ type mixture = agent list list
type edit_notation = {
mix: mixture;
delta_token:
((mixture, string) Alg_expr.e Locality.annoted * string Locality.annoted) list;
((mixture, string) Alg_expr.e Locality.annoted * string Locality.annoted)
list;
}

type arrow_notation = {
lhs: mixture;
rm_token:
((mixture, string) Alg_expr.e Locality.annoted * string Locality.annoted) list;
((mixture, string) Alg_expr.e Locality.annoted * string Locality.annoted)
list;
rhs: mixture;
add_token:
((mixture, string) Alg_expr.e Locality.annoted * string Locality.annoted) list;
((mixture, string) Alg_expr.e Locality.annoted * string Locality.annoted)
list;
}

type rule_content = Edit of edit_notation | Arrow of arrow_notation
Expand All @@ -78,8 +81,10 @@ type rule = {
let flip_label str = str ^ "_op"

type ('pattern, 'mixture, 'id, 'rule) modif_expr =
| APPLY of (('pattern, 'id) Alg_expr.e Locality.annoted * 'rule Locality.annoted)
| UPDATE of ('id Locality.annoted * ('pattern, 'id) Alg_expr.e Locality.annoted)
| APPLY of
(('pattern, 'id) Alg_expr.e Locality.annoted * 'rule Locality.annoted)
| UPDATE of
('id Locality.annoted * ('pattern, 'id) Alg_expr.e Locality.annoted)
| STOP of ('pattern, 'id) Alg_expr.e Primitives.print_expr list
| SNAPSHOT of bool * ('pattern, 'id) Alg_expr.e Primitives.print_expr list
| PRINT of
Expand Down Expand Up @@ -138,15 +143,15 @@ type ('pattern, 'mixture, 'id, 'rule) command =
type ('agent, 'pattern, 'mixture, 'id, 'rule) compil = {
filenames: string list;
variables: ('pattern, 'id) variable_def list;
(** pattern declaration for reusing as variable in perturbations
(** pattern declaration for reusing as variable in perturbations
or kinetic rate *)
signatures: 'agent list; (** agent signature declaration *)
signatures: 'agent list; (** agent signature declaration *)
rules: (string Locality.annoted option * 'rule Locality.annoted) list;
(** rules (possibly named) *)
(** rules (possibly named) *)
observables: ('pattern, 'id) Alg_expr.e Locality.annoted list;
(** list of patterns to plot *)
(** list of patterns to plot *)
init: ('pattern, 'mixture, 'id) init_statment list;
(** initial graph declaration *)
(** initial graph declaration *)
perturbations: ('pattern, 'mixture, 'id, 'rule) perturbation list;
configurations: configuration list;
tokens: string Locality.annoted list;
Expand Down Expand Up @@ -298,7 +303,8 @@ let port_to_json filenames p =
| Some x -> Locality.yojson_of_annoted ~filenames JsonUtil.of_int x)
in
let mod_i =
JsonUtil.of_option (Locality.yojson_of_annoted ~filenames JsonUtil.of_string)
JsonUtil.of_option
(Locality.yojson_of_annoted ~filenames JsonUtil.of_string)
in
JsonUtil.smart_assoc
[
Expand Down Expand Up @@ -339,7 +345,8 @@ let build_port_of_json filenames n i l =
in
let mod_i =
JsonUtil.to_option
(Locality.annoted_of_yojson ~filenames (JsonUtil.to_string ?error_msg:None))
(Locality.annoted_of_yojson ~filenames
(JsonUtil.to_string ?error_msg:None))
in
let port_int, port_int_mod =
match i with
Expand Down Expand Up @@ -426,13 +433,15 @@ let site_to_json filenames = function
`Assoc
[
( "counter_name",
Locality.yojson_of_annoted ~filenames JsonUtil.of_string c.counter_name );
Locality.yojson_of_annoted ~filenames JsonUtil.of_string
c.counter_name );
( "counter_test",
JsonUtil.of_option
(Locality.yojson_of_annoted ~filenames counter_test_to_json)
c.counter_test );
( "counter_delta",
Locality.yojson_of_annoted ~filenames JsonUtil.of_int c.counter_delta );
Locality.yojson_of_annoted ~filenames JsonUtil.of_int c.counter_delta
);
]

let print_agent_mod f = function
Expand Down Expand Up @@ -536,7 +545,8 @@ let to_dummy_user_internal = function
| _ :: _ :: _ as l -> Some (List_util.map_option fst l)

let to_dummy_user_site = function
| Port { port_name; port_int; port_int_mod = _; port_link; port_link_mod = _ } ->
| Port { port_name; port_int; port_int_mod = _; port_link; port_link_mod = _ }
->
{
User_graph.site_name = fst port_name;
User_graph.site_type =
Expand Down Expand Up @@ -1070,7 +1080,9 @@ let modif_to_json filenames f_mix f_var = function
`List [ `String "CFLOWLABEL"; `Bool b; string_annot_to_json filenames id ]
| CFLOWMIX (b, m) ->
`List
[ `String "CFLOW"; `Bool b; Locality.yojson_of_annoted ~filenames f_mix m ]
[
`String "CFLOW"; `Bool b; Locality.yojson_of_annoted ~filenames f_mix m;
]
| DIN (b, file) ->
`List
[
Expand Down Expand Up @@ -1263,7 +1275,7 @@ let sig_from_perts =
p)
acc p)

let implicit_signature r =
let infer_agent_signatures r =
let acc = sig_from_inits (r.signatures, r.tokens) r.init in
let acc' = sig_from_rules acc r.rules in
let ags, toks = sig_from_perts acc' r.perturbations in
Expand Down Expand Up @@ -1308,14 +1320,20 @@ let split_mixture m =
(match p.port_link_mod with
| None -> p.port_link
| Some None ->
[ Locality.annotate_with_dummy LKappa.LNK_FREE ]
[
Locality.annotate_with_dummy LKappa.LNK_FREE;
]
| Some (Some (i, pos)) ->
[ LKappa.LNK_VALUE (i, ()), pos ]);
port_link_mod = None;
}
:: r )
| Counter c ->
( Counter { c with counter_delta = Locality.annotate_with_dummy 0 }
( Counter
{
c with
counter_delta = Locality.annotate_with_dummy 0;
}
:: l,
Counter { c with counter_test = None } :: r ))
([], []) intf
Expand Down Expand Up @@ -1373,7 +1391,8 @@ let compil_to_json c =
c.init );
( "perturbations",
JsonUtil.of_list
(Locality.yojson_of_annoted ~filenames (fun (alarm, pre, modif, post) ->
(Locality.yojson_of_annoted ~filenames
(fun (alarm, pre, modif, post) ->
`List
[
JsonUtil.of_option Nbr.to_yojson alarm;
Expand Down
Loading

0 comments on commit 5cf07b4

Please sign in to comment.