socNameC.ml

(** Time-stamp: <modified the 21/07/2022 (at 10:23) 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 -> assert false
    | 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