Project

General

Profile

Revision 96f5fe18

View differences:

src/c_backend.ml
333 333 
let pp_instance_call m self fmt i (inputs: value_t list) (outputs: var_decl list) =
334 334 
 try (* stateful node instance *)
335 335 
   let (n,_) = List.assoc i m.minstances in
336 
   fprintf fmt "%s_step (%a%t%a%t%s->%s);"
337 
     (node_name n)
336 
   fprintf fmt "%a (%a%t%a%t%s->%s);"
337 
     pp_machine_step_name (node_name n)
338 338 
     (Utils.fprintf_list ~sep:", " (pp_c_val self (pp_c_var_read m))) inputs
339 339 
     (Utils.pp_final_char_if_non_empty ", " inputs)
340 340 
     (Utils.fprintf_list ~sep:", " (pp_c_var_write m)) outputs
......
343 343 
     i
344 344 
 with Not_found -> (* stateless node instance *)
345 345 
   let (n,_) = List.assoc i m.mcalls in
346 
   fprintf fmt "%s (%a%t%a);"
347 
     (node_name n)
346 
   fprintf fmt "%a (%a%t%a);"
347 
     pp_machine_step_name (node_name n)
348 348 
     (Utils.fprintf_list ~sep:", " (pp_c_val self (pp_c_var_read m))) inputs
349 349 
     (Utils.pp_final_char_if_non_empty ", " inputs)
350 350 
     (Utils.fprintf_list ~sep:", " (pp_c_var_write m)) outputs
......
504 504 
    self
505 505 

  		




  506
  506
  
    
let print_stateless_prototype fmt (name, inputs, outputs) =


  		




  507
  
  
    
  fprintf fmt "void %s (@[<v>@[%a%t@]@,@[%a@]@,@])"


  		




  508
  
  
    
    name


  		




  
  507
  
    
  fprintf fmt "void %a (@[<v>@[%a%t@]@,@[%a@]@,@])"


  		




  
  508
  
    
    pp_machine_step_name name


  		




  509
  509
  
    
    (Utils.fprintf_list ~sep:",@ " pp_c_decl_input_var) inputs


  		




  510
  510
  
    
    (Utils.pp_final_char_if_non_empty ",@ " inputs) 


  		




  511
  511
  
    
    (Utils.fprintf_list ~sep:",@ " pp_c_decl_output_var) outputs


  		












  

    
      src/types.ml
    
  





  51
  51
  
    
  | Already_bound of ident


  		




  52
  52
  
    
  | Already_defined of ident


  		




  53
  53
  
    
  | Undefined_var of (unit IMap.t)


  		




  
  54
  
    
  | Declared_but_undefined of ident


  		




  54
  55
  
    
  | Unbound_type of ident


  		




  55
  56
  
    
  | Not_a_dimension


  		




  56
  57
  
    
  | Not_a_constant


  		




  ......




  106
  107
  
    
  fprintf fmt "%a : %a" pp_print_string label print_node_ty ty


  		




  107
  108
  
    
and print_node_ty fmt ty =


  		




  108
  109
  
    
  match ty.tdesc with


  		




  
  110
  
    
  | Tvar -> begin


  		




  
  111
  
    
Format.eprintf "DEBUG:Types.print_node@.";


  		




  
  112
  
    
    fprintf fmt "_%s" (name_of_type ty.tid)


  		




  
  113
  
    
end


  		




  109
  114
  
    
  | Tint ->


  		




  110
  115
  
    
    fprintf fmt "int"


  		




  111
  116
  
    
  | Treal ->


  		




  ......




  158
  163
  
    
    fprintf fmt "No definition provided for variable(s): %a@."


  		




  159
  164
  
    
      (Utils.fprintf_list ~sep:"," pp_print_string)


  		




  160
  165
  
    
      (fst (Utils.list_of_imap vmap))


  		




  
  166
  
    
  | Declared_but_undefined id ->


  		




  
  167
  
    
     fprintf fmt "Node %s is declared but not defined@." id


  		




  161
  168
  
    
  | Type_clash (ty1,ty2) ->


  		




  162
  169
  
    
      Utils.reset_names ();


  		




  163
  170
  
    
    fprintf fmt "Expected type %a, got type %a@." print_ty ty1 print_ty ty2


  		












  

    
      src/typing.ml
    
  





  764
  764
  
    
let uneval_prog_generics prog =


  		




  765
  765
  
    
 List.iter uneval_top_generics prog


  		




  766
  766
  
    

  		




  
  767
  
    
let rec get_imported_node decls id =


  		




  
  768
  
    
  match decls with


  		




  
  769
  
    
  | [] -> assert false


  		




  
  770
  
    
  | decl::q ->


  		




  
  771
  
    
     (match decl.top_decl_desc with


  		




  
  772
  
    
      | ImportedNode nd when id = nd.nodei_id -> decl


  		




  
  773
  
    
      | _ -> get_imported_node q id)


  		




  
  774
  
    

  		




  767
  775
  
    
let check_env_compat header declared computed = 


  		




  768
  776
  
    
  uneval_prog_generics header;


  		




  769
  777
  
    
  Env.iter declared (fun k decl_type_k -> 


  		




  770
  
  
    
    let computed_t = instantiate (ref []) (ref []) (Env.lookup_value computed k) in


  		




  
  778
  
    
    let computed_t = instantiate (ref []) (ref []) 


  		




  
  779
  
    
				 (try Env.lookup_value computed k


  		




  
  780
  
    
				  with Not_found ->


  		




  
  781
  
    
				    let loc = (get_imported_node header k).top_decl_loc in 


  		




  
  782
  
    
				    raise (Error (loc, Declared_but_undefined k))) in


  		




  771
  783
  
    
    (*Types.print_ty Format.std_formatter decl_type_k;


  		




  772
  784
  
    
    Types.print_ty Format.std_formatter computed_t;*)


  		




  773
  785
  
    
    try_semi_unify decl_type_k computed_t Location.dummy_loc


  		




  774
  
  
    
  ) 


  		




  
  786
  
    
		    )


  		




  775
  787
  
    

  		




  776
  788
  
    
(* Local Variables: *)


  		




  777
  789
  
    
(* compile-command:"make -C .." *)


  		












Also available in:  Unified diff