CristalCaveGem » LustreC

  val pp_cond : Format.formatter -> t -> unit

end

struct

  type t =

    | Quote of base_condition_t

end

let _ = (module Condition : ConditionType)

  | Junction of junction_name_t * transitions_t

  | SFFunction of 'prog_t

type scope_t = Constant | Input | Local | Output | Parameter

    Format.fprintf fmt "Main node name: %s@ %a@ %a@"

      name

      (pp_src pp_sffunction) component_list

  let pp_scope fmt src =

    Format.fprintf fmt (match src with

    end) in

    let module Sem = CPS.Semantics (T) (Model) in

    let prog = Sem.code_gen modularmode in

    Options.print_dec_types := true;

    let auto_file = "sf_gen_test_auto.lus" in (* Could be changed *)

    let auto_out = open_out auto_file in

    let auto_fmt = Format.formatter_of_out_channel auto_out in

    Format.fprintf auto_fmt "%a@." Printers.pp_prog prog;

    let prog, deps = Compiler_stages.stage1 prog "" "" in

    let noauto_file = "sf_gen_test_noauto.lus" in (* Could be changed *)

    let noauto_out = open_out noauto_file in

    let noauto_fmt = Format.formatter_of_out_channel noauto_out in

  with Parse.Error (l, err) -> Format.eprintf "Parse error at loc %a : %a@.@?" Location.pp_loc l Parse.pp_error err

let name = "simple"

  let action _ = no_action

let model : prog_t =

let verbose = false

let actionv x = no_action (*TODO if verbose then action x else no_action*)

let action x = no_action (* TODO *)

let name = "stopwatch"

let model =

	 int_typ, (* type *)

	 Corelang.dummy_clock_dec, (* clock *)

	 false, (* not a constant *)

    )

      ["cent";

       "sec";

module Prog =

struct

    let Program (init, defs, globals) = M.model in

    let state_vars = SF.states M.model in

(*let _ = Format.printf "Model definitions@.%a@.####" Simulink.pp_src defs; () *)

end

module LustrePrinter (

  Vars : sig

    val state_vars : ActiveStates.Vars.t

  end) : TransformerType =

struct

  include TransformerStub

    let loc = Location.dummy_loc in

    Corelang.mkvar_decl

      loc

  let var_to_vdecl ?(prefix="") var typ = mkvar (var_to_ident prefix var) typ 

  let state_vars_to_vdecl_list ?(prefix="") vars =

    LustreSpec.ty_dec_loc = Location.dummy_loc;

  }

  let const_map : (event_base_t, int) Hashtbl.t = Hashtbl.create 13

	let (vars', tr') = tr "sin_" "sout_" in

	pp_name call args;

	let funname = Format.flush_str_formatter () in

	let node =

	  Corelang.mktop (	

	    LustreSpec.Node {LustreSpec.node_id = funname;

			   node_type = Types.new_var ();

			   node_clock = Clocks.new_var true;

			   node_locals = mk_locals vars'; (* TODO: add global vars *)

			   node_gencalls = [];

			   node_checks = [];

      )  

	in

	[node]

  let mk_main_loop () =

    (* let loc = Location.dummy_loc in *)

    let call_stmt =

      (* (%t) -> pre (thetaCallD_from_principal (event, %a)) *)

      in

      let args = (Corelang.expr_of_vdecl event_var)::

	(vars_to_exprl ~prefix:"sout_" Vars.state_vars)

      let rhs = mkexpr (LustreSpec.Expr_arrow (init, pre_call_expr)) in

      mkstmt_eq Vars.state_vars ~prefix_lhs:"sout_" rhs

    in

    let node_principal =

      Corelang.mktop (	

	LustreSpec.Node {LustreSpec.node_id = "principal_loop";

			 node_type = Types.new_var ();

			 node_clock = Clocks.new_var true;

			 node_locals = []; (* TODO: add global vars *)

			 node_gencalls = [];

			 node_checks = [];

			 node_annot = []}

      )  

    in

  let mkprincipal tr =

  | GenLus ->

     let module Model = (val model) in

     let state_vars = Datatype.SF.states Model.model in

     let module T = CPS_lustre_generator.LustrePrinter (struct

       let state_vars = state_vars