<commit_before>(********************************************************************)
(*                                                                  *)
(*  The LustreC compiler toolset   /  The LustreC Development Team  *)
(*  Copyright 2012 -    --   ONERA - CNRS - INPT                    *)
(*                                                                  *)
(*  LustreC is free software, distributed WITHOUT ANY WARRANTY      *)
(*  under the terms of the GNU Lesser General Public License        *)
(*  version 2.1.                                                    *)
(*                                                                  *)
(********************************************************************)

open Format
open LustreSpec
open Corelang
open Machine_code


let print_version fmt =
  Format.fprintf fmt 
    "/* @[<v>C code generated by %s@,SVN version number %s@,Code is %s compliant */@,@]@."
    (Filename.basename Sys.executable_name) 
    Version.number 
    (if !Options.ansi then "ANSI C90" else "C99")
 
(* Generation of a non-clashing name for the self memory variable (for step and reset functions) *)
let mk_self m =
  let used name =
       (List.exists (fun v -> v.var_id = name) m.mstep.step_inputs)
    || (List.exists (fun v -> v.var_id = name) m.mstep.step_outputs)
    || (List.exists (fun v -> v.var_id = name) m.mstep.step_locals)
    || (List.exists (fun v -> v.var_id = name) m.mmemory) in
  mk_new_name used "self"

(* Generation of a non-clashing name for the instance variable of static allocation macro *)
let mk_instance m =
  let used name =
       (List.exists (fun v -> v.var_id = name) m.mstep.step_inputs)
    || (List.exists (fun v -> v.var_id = name) m.mmemory) in
  mk_new_name used "inst"

(* Generation of a non-clashing name for the attribute variable of static allocation macro *)
let mk_attribute m =
  let used name =
       (List.exists (fun v -> v.var_id = name) m.mstep.step_inputs)
    || (List.exists (fun v -> v.var_id = name) m.mmemory) in
  mk_new_name used "attr"

let mk_call_var_decl loc id =
  { var_id = id;
    var_orig = false;
    var_dec_type = mktyp Location.dummy_loc Tydec_any;
    var_dec_clock = mkclock Location.dummy_loc Ckdec_any;
    var_dec_const = false;
    var_dec_value = None;
    var_type = Type_predef.type_arrow (Types.new_var ()) (Types.new_var ());
    var_clock = Clocks.new_var true;
    var_loc = loc }

(* counter for loop variable creation *)
let loop_cpt = ref (-1)

let reset_loop_counter () =
 loop_cpt := -1

let mk_loop_var m () =
  let vars = m.mstep.step_inputs@m.mstep.step_outputs@m.mstep.step_locals@m.mmemory in
  let rec aux () =
    incr loop_cpt;
    let s = Printf.sprintf "__%s_%d" "i" !loop_cpt in
    if List.exists (fun v -> v.var_id = s) vars then aux () else s
  in aux ()
(*
let addr_cpt = ref (-1)

let reset_addr_counter () =
 addr_cpt := -1

let mk_addr_var m var =
  let vars = m.mmemory in
  let rec aux () =
    incr addr_cpt;
    let s = Printf.sprintf "%s_%s_%d" var "addr" !addr_cpt in
    if List.exists (fun v -> v.var_id = s) vars then aux () else s
  in aux ()
*)
let pp_machine_memtype_name fmt id = fprintf fmt "struct %s_mem" id
let pp_machine_regtype_name fmt id = fprintf fmt "struct %s_reg" id
let pp_machine_alloc_name fmt id = fprintf fmt "%s_alloc" id
let pp_machine_static_declare_name fmt id = fprintf fmt "%s_DECLARE" id
let pp_machine_static_link_name fmt id = fprintf fmt "%s_LINK" id
let pp_machine_static_alloc_name fmt id = fprintf fmt "%s_ALLOC" id
let pp_machine_reset_name fmt id = fprintf fmt "%s_reset" id
let pp_machine_init_name fmt id = fprintf fmt "%s_init" id
let pp_machine_clear_name fmt id = fprintf fmt "%s_clear" id
let pp_machine_step_name fmt id = fprintf fmt "%s_step" id

let rec pp_c_dimension fmt dim =
  match dim.Dimension.dim_desc with
  | Dimension.Dident id       ->
    fprintf fmt "%s" id
  | Dimension.Dint i          ->
    fprintf fmt "%d" i
  | Dimension.Dbool b         ->
    fprintf fmt "%B" b
  | Dimension.Dite (i, t, e)  ->
    fprintf fmt "((%a)?%a:%a)"
       pp_c_dimension i pp_c_dimension t pp_c_dimension e
 | Dimension.Dappl (f, args) ->
     fprintf fmt "%a" (Basic_library.pp_c f pp_c_dimension) args
 | Dimension.Dlink dim' -> fprintf fmt "%a" pp_c_dimension dim'
 | Dimension.Dvar       -> fprintf fmt "_%s" (Utils.name_of_dimension dim.Dimension.dim_id)
 | Dimension.Dunivar    -> fprintf fmt "'%s" (Utils.name_of_dimension dim.Dimension.dim_id)

let is_basic_c_type t =
  match (Types.repr t).Types.tdesc with
  | Types.Tbool | Types.Treal | Types.Tint  -> true
  | _                                       -> false

let pp_basic_c_type fmt t =
  match (Types.repr t).Types.tdesc with
  | Types.Tbool                    -> fprintf fmt "_Bool"
  | Types.Treal when !Options.mpfr -> fprintf fmt "%s" Mpfr.mpfr_t
  | Types.Treal                    -> fprintf fmt "double"
  | Types.Tint                     -> fprintf fmt "int"
  | _ -> assert false (* Not a basic C type. Do not handle arrays or pointers *)

let pp_c_type var fmt t =
  let rec aux t pp_suffix =
    match (Types.repr t).Types.tdesc with
    | Types.Tclock t'       -> aux t' pp_suffix
    | Types.Tbool | Types.Tint | Types.Treal
                            -> fprintf fmt "%a %s%a" pp_basic_c_type t var pp_suffix ()
    | Types.Tarray (d, t')  ->
      let pp_suffix' fmt () = fprintf fmt "%a[%a]" pp_suffix () pp_c_dimension d in
      aux t' pp_suffix'
    | Types.Tstatic (_, t') -> fprintf fmt "const "; aux t' pp_suffix
    | Types.Tconst ty       -> fprintf fmt "%s %s" ty var
    | Types.Tarrow (_, _)   -> fprintf fmt "void (*%s)()" var
    | _                     -> eprintf "internal error: C_backend_common.pp_c_type %a@." Types.print_ty t; assert false
  in aux t (fun fmt () -> ())
(*
let rec pp_c_initialize fmt t = 
  match (Types.repr t).Types.tdesc with
  | Types.Tint -> pp_print_string fmt "0"
  | Types.Tclock t' -> pp_c_initialize fmt t'
  | Types.Tbool -> pp_print_string fmt "0" 
  | Types.Treal when not !Options.mpfr -> pp_print_string fmt "0."
  | Types.Tarray (d, t') when Dimension.is_dimension_const d -><commit_msg>More informative error message in case of untyped value<commit_after>(********************************************************************)
(*                                                                  *)
(*  The LustreC compiler toolset   /  The LustreC Development Team  *)
(*  Copyright 2012 -    --   ONERA - CNRS - INPT                    *)
(*                                                                  *)
(*  LustreC is free software, distributed WITHOUT ANY WARRANTY      *)
(*  under the terms of the GNU Lesser General Public License        *)
(*  version 2.1.                                                    *)
(*                                                                  *)
(********************************************************************)

open Format
open LustreSpec
open Corelang
open Machine_code


let print_version fmt =
  Format.fprintf fmt 
    "/* @[<v>C code generated by %s@,SVN version number %s@,Code is %s compliant */@,@]@."
    (Filename.basename Sys.executable_name) 
    Version.number 
    (if !Options.ansi then "ANSI C90" else "C99")
 
(* Generation of a non-clashing name for the self memory variable (for step and reset functions) *)
let mk_self m =
  let used name =
       (List.exists (fun v -> v.var_id = name) m.mstep.step_inputs)
    || (List.exists (fun v -> v.var_id = name) m.mstep.step_outputs)
    || (List.exists (fun v -> v.var_id = name) m.mstep.step_locals)
    || (List.exists (fun v -> v.var_id = name) m.mmemory) in
  mk_new_name used "self"

(* Generation of a non-clashing name for the instance variable of static allocation macro *)
let mk_instance m =
  let used name =
       (List.exists (fun v -> v.var_id = name) m.mstep.step_inputs)
    || (List.exists (fun v -> v.var_id = name) m.mmemory) in
  mk_new_name used "inst"

(* Generation of a non-clashing name for the attribute variable of static allocation macro *)
let mk_attribute m =
  let used name =
       (List.exists (fun v -> v.var_id = name) m.mstep.step_inputs)
    || (List.exists (fun v -> v.var_id = name) m.mmemory) in
  mk_new_name used "attr"

let mk_call_var_decl loc id =
  { var_id = id;
    var_orig = false;
    var_dec_type = mktyp Location.dummy_loc Tydec_any;
    var_dec_clock = mkclock Location.dummy_loc Ckdec_any;
    var_dec_const = false;
    var_dec_value = None;
    var_type = Type_predef.type_arrow (Types.new_var ()) (Types.new_var ());
    var_clock = Clocks.new_var true;
    var_loc = loc }

(* counter for loop variable creation *)
let loop_cpt = ref (-1)

let reset_loop_counter () =
 loop_cpt := -1

let mk_loop_var m () =
  let vars = m.mstep.step_inputs@m.mstep.step_outputs@m.mstep.step_locals@m.mmemory in
  let rec aux () =
    incr loop_cpt;
    let s = Printf.sprintf "__%s_%d" "i" !loop_cpt in
    if List.exists (fun v -> v.var_id = s) vars then aux () else s
  in aux ()
(*
let addr_cpt = ref (-1)

let reset_addr_counter () =
 addr_cpt := -1

let mk_addr_var m var =
  let vars = m.mmemory in
  let rec aux () =
    incr addr_cpt;
    let s = Printf.sprintf "%s_%s_%d" var "addr" !addr_cpt in
    if List.exists (fun v -> v.var_id = s) vars then aux () else s
  in aux ()
*)
let pp_machine_memtype_name fmt id = fprintf fmt "struct %s_mem" id
let pp_machine_regtype_name fmt id = fprintf fmt "struct %s_reg" id
let pp_machine_alloc_name fmt id = fprintf fmt "%s_alloc" id
let pp_machine_static_declare_name fmt id = fprintf fmt "%s_DECLARE" id
let pp_machine_static_link_name fmt id = fprintf fmt "%s_LINK" id
let pp_machine_static_alloc_name fmt id = fprintf fmt "%s_ALLOC" id
let pp_machine_reset_name fmt id = fprintf fmt "%s_reset" id
let pp_machine_init_name fmt id = fprintf fmt "%s_init" id
let pp_machine_clear_name fmt id = fprintf fmt "%s_clear" id
let pp_machine_step_name fmt id = fprintf fmt "%s_step" id

let rec pp_c_dimension fmt dim =
  match dim.Dimension.dim_desc with
  | Dimension.Dident id       ->
    fprintf fmt "%s" id
  | Dimension.Dint i          ->
    fprintf fmt "%d" i
  | Dimension.Dbool b         ->
    fprintf fmt "%B" b
  | Dimension.Dite (i, t, e)  ->
    fprintf fmt "((%a)?%a:%a)"
       pp_c_dimension i pp_c_dimension t pp_c_dimension e
 | Dimension.Dappl (f, args) ->
     fprintf fmt "%a" (Basic_library.pp_c f pp_c_dimension) args
 | Dimension.Dlink dim' -> fprintf fmt "%a" pp_c_dimension dim'
 | Dimension.Dvar       -> fprintf fmt "_%s" (Utils.name_of_dimension dim.Dimension.dim_id)
 | Dimension.Dunivar    -> fprintf fmt "'%s" (Utils.name_of_dimension dim.Dimension.dim_id)

let is_basic_c_type t =
  match (Types.repr t).Types.tdesc with
  | Types.Tbool | Types.Treal | Types.Tint  -> true
  | _                                       -> false

let pp_basic_c_type fmt t =
  match (Types.repr t).Types.tdesc with
  | Types.Tbool                    -> fprintf fmt "_Bool"
  | Types.Treal when !Options.mpfr -> fprintf fmt "%s" Mpfr.mpfr_t
  | Types.Treal                    -> fprintf fmt "double"
  | Types.Tint                     -> fprintf fmt "int"
  | _ -> assert false (* Not a basic C type. Do not handle arrays or pointers *)

let pp_c_type var fmt t =
  let rec aux t pp_suffix =
    match (Types.repr t).Types.tdesc with
    | Types.Tclock t'       -> aux t' pp_suffix
    | Types.Tbool | Types.Tint | Types.Treal
                            -> fprintf fmt "%a %s%a" pp_basic_c_type t var pp_suffix ()
    | Types.Tarray (d, t')  ->
      let pp_suffix' fmt () = fprintf fmt "%a[%a]" pp_suffix () pp_c_dimension d in
      aux t' pp_suffix'
    | Types.Tstatic (_, t') -> fprintf fmt "const "; aux t' pp_suffix
    | Types.Tconst ty       -> fprintf fmt "%s %s" ty var
    | Types.Tarrow (_, _)   -> fprintf fmt "void (*%s)()" var
    | _                     -> eprintf "internal error: C_backend_common.pp_c_type var %s: %a@." var Types.print_ty t; assert false
  in aux t (fun fmt () -> ())
(*
let rec pp_c_initialize fmt t = 
  match (Types.repr t).Types.tdesc with
  | Types.Tint -> pp_print_string fmt "0"
  | Types.Tclock t' -> pp_c_initialize fmt t'
  | Types.Tbool -> pp_print_string fmt "0" 
  | Types.Treal when not !Options.mpfr -> pp_print_string fmt "0."
  | Types.Tarray (d, t') when Dimension.is_dimension_const d ->
{'fraction_non_alphanumeric': 0.1320877335499594, 'fraction_numerical': 0.002761982128350934, 'mean_word_length': 2.5014220705346983, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 81, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 6, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 22, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2345119', 'n_tokens_mistral': 4173, 'n_tokens_neox': 4093, 'n_words': 1255}