CristalCaveGem » LustreC

  | Tydec_struct fl -> Type_predef.type_struct (List.map (fun (f, ty) -> (f, type_coretype type_dim ty)) fl)

  | Tydec_array (d, ty) ->

    begin

      type_dim d;

      Type_predef.type_array d (type_coretype type_dim ty)

    end

  then raise (Error (loc, Not_a_constant))

let rec type_add_const env const arg targ =

  if const

  then let d =

	 if is_dimension_type targ

(* type a call with possible dependent types. [targs] is here a list of (argument, type) pairs. *)

and type_dependent_call env in_main loc const f targs =

  let tins, touts = new_var (), new_var () in

  let tfun = Type_predef.type_arrow tins touts in

  type_subtyping_arg env in_main const (expr_of_ident f loc) tfun;

    begin

      List.iter2 (fun (a,t) ti ->

	let t' = type_add_const env (const || Types.get_static_value ti <> None) a t

    end

(* type a simple call without dependent types 

(** [type_eq env eq] types equation [eq] in environment [env] *)

let type_eq env in_main undefined_vars eq =

  (* Check undefined variables, type lhs *)

  let expr_lhs = expr_of_expr_list eq.eq_loc (List.map (fun v -> expr_of_ident v eq.eq_loc) eq.eq_lhs) in

  let ty_lhs = type_expr env in_main false expr_lhs in

  (* Check multiple variable definitions *)

  let define_var id uvars =

  in

  (* check assignment of declared constant, assignment of clock *)

  let ty_lhs =

 | _                   -> ()

let type_var_decl vd_env env vdecl =

  check_type_declaration vdecl.var_loc vdecl.var_dec_type.ty_dec_desc;

  let eval_const id = Types.get_static_value (Env.lookup_value env id) in

  let type_dim d =

    begin

      type_subtyping_arg (env, vd_env) false true (expr_of_dimension d) Type_predef.type_int;

      Dimension.eval Basic_library.eval_env eval_const d;

    end in

  let ty = type_coretype type_dim vdecl.var_dec_type.ty_dec_desc in

    if vdecl.var_dec_const

    else ty in

  type_coreclock (new_env,vd_env) vdecl.var_dec_clock vdecl.var_id vdecl.var_loc;

  new_env

let type_var_decl_list vd_env env l =

  let new_env = Env.overwrite env delta_env in

  let undefined_vars_init =

    List.fold_left

  let undefined_vars =

    List.fold_left (type_eq (new_env, vd_env) is_main) undefined_vars_init (get_node_eqs nd)

  in

  )  nd.node_asserts;

  (* check that table is empty *)

    raise (Error (loc, Undefined_var undefined_vars));

  let ty_ins = type_of_vlist nd.node_inputs in

  let ty_outs = type_of_vlist nd.node_outputs in

      try

	type_node env nd decl.top_decl_loc

      with Error (loc, err) as exc -> (

	  Format.eprintf "Type error: failing node@.%a@.@?"

	    Printers.pp_node nd

	raise exc)

  )

  | ImportedNode nd ->

let check_typedef_top decl =

(*Format.eprintf "check_typedef %a@." Printers.pp_short_decl decl;*)

(*Format.eprintf "%a" Corelang.print_type_table ();*)

  match decl.top_decl_desc with

  | TypeDef ty ->

       try Hashtbl.find type_table (Tydec_const (typedef_of_top decl).tydef_id)

       with Not_found -> raise (Error (decl.top_decl_loc, Declared_but_undefined ("type "^ ty.tydef_id))) in

     let owner' = decl'.top_decl_owner in

     let itf' = decl'.top_decl_itf in

     (match decl'.top_decl_desc with

     | Const _ | Node _ | ImportedNode _ -> assert false