lus2licRun.ml

(* Time-stamp: <modified the 03/07/2017 (at 10:38) by Erwan Jahier> *)
(*-----------------------------------------------------------------------
** Copyright (C) - Verimag.
*)

type vars = (string * Data.t) list

open Lv6MainArgs
open Soc
open SocExecValue
open RdbgPlugin

let make argv =
  let opt = Lv6MainArgs.parse argv in
  Lv6Verbose.exe ~level:3 (fun () ->
    Gc.set { (Gc.get ()) with Gc.verbose = 0x01 }
  );
  if (opt.infiles = []) then (
    Lv6MainArgs.usage stderr opt;
    exit 1
  );
  let new_dft_pack = Filename.basename (Filename.chop_extension (List.hd opt.infiles)) in
  Lv6Id.set_dft_pack_name new_dft_pack;

  let main_node = 
    if opt.main_node = "" then None else 
      Some (Lv6Id.idref_of_string opt.main_node)
  in
  if opt.outfile <> "" then opt.oc <- open_out opt.outfile;
  let nsl = Lv6Compile.get_source_list opt opt.infiles in
  let lic_prg = Lv6Compile.doit opt nsl main_node in

  let nk = (Lic.node_key_of_idref (Lv6Id.to_idref opt.main_node)) in
  let sk, soc_tbl = 
    if LicPrg.node_exists lic_prg nk then (
      Lic2soc.f lic_prg nk 
    ) else (
      print_string ("Error: cannot find node "^opt.main_node^" in "^
                       (String.concat "," opt.infiles)^".\n");
      flush stdout;
      exit 1
    )
  in
  let soc = SocUtils.find_no_exc sk soc_tbl in
  let soc_inputs,soc_outputs = soc.profile in
  let soc_inputs,soc_outputs =
    if opt.Lv6MainArgs.expand_io_type then
      (SocVar.expand_profile true false (fst soc.profile)),
      (SocVar.expand_profile true false (snd soc.profile))
    else
      soc_inputs,soc_outputs
  in
  let (vntl_i:Data.vntl) =  soc_inputs in
  let (vntl_o:Data.vntl) =  soc_outputs in
(*   LicDump.dump_entete oc; *)
(*   RifIO.write_interface oc vntl_i vntl_o None None; *)
(*   RifIO.flush oc; *)

  let (to_soc_subst : SocExecValue.ctx -> Soc.var list -> Data.subst list) =
    fun ctx vl ->
      (*       let sl = List.map (fun var -> fst var, SocExecValue.get_value ctx (Var var)) vl in *)
      let sl = SocExecValue.filter_top_subst ctx.s in
      let sl = List.flatten (List.map SocVar.expand_subst sl) in
      (* If the order ever matters, I could try the following.  :
         try List.map (fun v -> fst v,
         List.assoc (fst v) sl) vl with Not_found -> assert false
      *)
      sl
  in
  let (add_subst : Data.subst list -> SocExecValue.substs -> SocExecValue.substs) = 
    fun s ctx_s ->
      let s = SocVar.unexpand_profile s (fst soc.profile) in
      List.fold_left (fun acc (id,v) -> SocExecValue.sadd acc [id] v) ctx_s s
  in
  let ctx_ref = ref (SocExecValue.create_ctx soc_tbl soc) in
  let step sl_in =
    let ctx = { !ctx_ref with s = add_subst sl_in !ctx_ref.s } in
    let ctx = SocExecDbg.do_step soc_tbl soc ctx in
    let sl_out = to_soc_subst ctx soc_outputs in
    ctx_ref := ctx;
    (*     RifIO.write_outputs oc Util.my_string_of_float  vntl_o sl_out; *)
    (*     RifIO.flush oc; *)
    sl_out
  in
  let step_dbg sl_in ectx cont =
    let cont2 ectx ctx =
      let sl_out = to_soc_subst ctx soc_outputs in
      ctx_ref := ctx;
      cont sl_out ectx
    in
    ctx_ref := { !ctx_ref with s = add_subst sl_in !ctx_ref.s };
    SocExecDbg.do_step_dbg soc_tbl soc ectx !ctx_ref cont2
  in 
  let (mems_in  : Data.subst list) = [] in (* XXX todo *)
  let (mems_out : Data.subst list) = [] in (* XXX todo *)
  {
    id = Printf.sprintf "%s (with lus2lic Version %s)"
                        (String.concat " " (Array.to_list argv)) Lv6version.str;
    inputs = vntl_i;
    outputs= vntl_o;
    kill=(fun _ -> ());
    init_inputs=mems_in;
    init_outputs=mems_out;
    step=step;     
    step_dbg=step_dbg;
  }