(** Time-stamp: <modified the 22/07/2022 (at 14:31) by Erwan Jahier> *) type variable_type = { id: int; name: string; var_type: string } type node_type = { file_name: string; fct_name: string; ctx: bool; ctx_tab: string } type instance_type = { id: int; node: int; var_in: int list; var_out: int list; } let get_filename : Soc.t -> string = fun soc -> Soc2cIdent.get_base_name soc.key (* XXX get_ctx_type_name ? *) let get_ctx_name : Soc.t -> string = fun soc -> (Soc2cIdent.get_ctx_name soc.key) ^ "_type" let get_ctx_new : Soc.t -> string = fun soc -> (Soc2cIdent.get_ctx_name soc.key) ^ "_new_ctx" let var_to_variable_type offset i (vn, vt) = vn, { id = i+offset; name = vn; var_type = Soc2cUtil.type_to_string vt "" } let get_inputs_assoc : Soc.t -> (string * variable_type) list = fun soc -> List.mapi (var_to_variable_type 0) (fst soc.profile) let get_outputs_assoc : Soc.t -> (string * variable_type) list = fun soc -> List.mapi (var_to_variable_type (List.length (fst soc.profile))) (snd soc.profile) let get_inputs : Soc.t -> variable_type list = fun soc -> snd(List.split (get_inputs_assoc soc)) let get_outputs : Soc.t -> variable_type list = fun soc -> snd(List.split (get_outputs_assoc soc)) open Soc let get_variables_assoc : Soc.t -> (string * variable_type) list = fun soc -> let i,o = soc.profile in let io_nb = List.length i + (List.length o) in let step_impl = match soc.step with | [sm] -> sm.impl | [] -> assert false | _::_ -> assert false in let lvars = match step_impl with | Gaol (vl,_) -> vl | Predef | Iterator _ | Boolred _ | Condact _ | Extern -> [] in List.mapi (var_to_variable_type io_nb) lvars let get_variables : Soc.t -> variable_type list = fun soc -> snd(List.split (get_variables_assoc soc)) let get_gaol soc = let step_impl = match soc.step with | [sm] -> sm.impl | [] -> assert false | _::_ -> assert false in let gaol = match step_impl with | Gaol (_,gaol) -> gaol | Predef -> assert false | Iterator _ -> assert false | Boolred _ -> assert false | Condact _ -> assert false | Extern -> assert false in gaol let get_nodes : Soc.t -> node_type list = fun soc -> let gaol = get_gaol soc in let tbl = Hashtbl.create 2 in let gao_to_node_type (cpt, acc) = function | Call(_,ao,_,_) -> let is_method, k = match ao with | Assign -> assert false | Method((_,k),_) -> true, k | Procedure k -> false, k in if Hashtbl.mem tbl k then cpt, acc else ( Hashtbl.add tbl k 0; cpt+1, {file_name = Soc2cIdent.get_soc_name k; fct_name = (Soc2cIdent.get_soc_name k)^"_step"; ctx = is_method ; ctx_tab = if is_method then (Soc2cIdent.get_soc_name k)^"_ctx_tab" else "" }::acc ) | Case(_, _,_) -> assert false in List.rev (snd (List.fold_left gao_to_node_type (0, []) gaol)) let (var_expr_to_index : (string * variable_type) list -> var_expr -> int) = fun var_tbl v -> match v with | Var var -> ( match List.assoc_opt (fst var) var_tbl with | None -> assert false | Some vt -> vt.id ) | Const _ -> assert false | Field _ -> assert false | Index _ -> assert false | Slice _ -> assert false let print_instance_type i = Printf.printf "{id=%d ; node=%d ; var_in=[%s] ; var_out=[%s] }\n" i.id i.node (String.concat "," (List.map string_of_int i.var_in)) (String.concat "," (List.map string_of_int i.var_out)) let get_instances : Soc.t -> instance_type list = fun soc -> let gaol = get_gaol soc in let ltbl = Hashtbl.create 2 in let node_cpt_ref = ref (-1) in let all_vars = (get_inputs_assoc soc) @ (get_outputs_assoc soc) @ (get_variables_assoc soc) in let gao_to_instance_type i gao = match gao with | Call(_,Assign,_,_) -> assert false | Call(args_out, Method((_,k), _), args_in, _) | Call(args_out, Procedure k , args_in, _) -> let node_cpt, _inst_cpt = match Hashtbl.find_opt ltbl k with | None -> incr node_cpt_ref; Hashtbl.add ltbl k (!node_cpt_ref, 0); !node_cpt_ref, 0 | Some (node_cpt, inst_cpt) -> let inst_cpt = inst_cpt+1 in Hashtbl.add ltbl k (node_cpt, inst_cpt); node_cpt, inst_cpt in { id = i+1; node = node_cpt; var_in = List.map (var_expr_to_index all_vars) args_in; var_out = List.map (var_expr_to_index all_vars) args_out } | Case(_, _,_) -> assert false in let res = List.mapi gao_to_instance_type gaol in (* List.iter print_instance_type res; *) res