Project

General

Profile

Revision 3de9f6e4 src/backends/Ada/ada_backend_common.ml

View differences:

src/backends/Ada/ada_backend_common.ml
150 150
    | _ -> assert false (*TODO*)
151 151

  
152 152
(** Extract from a machine list the one corresponding to the given instance.
153
      assume that the machine is in the list.
153 154
   @param machines list of all machines
154 155
   @param instance instance of a machine
155 156
   @return the machine corresponding to hte given instance
156 157
**)
157 158
let get_machine machines instance =
158 159
    let id = (extract_node instance).node_id in
159
    List.find  (function m -> m.mname.node_id=id) machines
160
    try
161
      List.find (function m -> m.mname.node_id=id) machines
162
    with
163
      Not_found -> assert false
160 164

  
161 165

  
162 166
(* Type pretty print functions *)
......
218 222
    | Types.Tbasic Types.Basic.Treal -> pp_float_type fmt
219 223
    | Types.Tbasic Types.Basic.Tbool -> pp_boolean_type fmt
220 224
    | Types.Tunivar _                -> pp_polymorphic_type fmt typ.tid
225
    | Types.Tbasic _                 -> eprintf "Tbasic@."; assert false (*TODO*)
221 226
    | Types.Tconst _                 -> eprintf "Tconst@."; assert false (*TODO*)
222 227
    | Types.Tclock _                 -> eprintf "Tclock@."; assert false (*TODO*)
223 228
    | Types.Tarrow _                 -> eprintf "Tarrow@."; assert false (*TODO*)
......
231 236
    | _ -> eprintf "Type error : %a@." Types.print_ty typ; assert false (*TODO*)
232 237
  )
233 238

  
239

  
240
(** Test if two types are the same.
241
   @param typ1 the first type
242
   @param typ2 the second type
243
**)
244
let pp_eq_type typ1 typ2 = 
245
  let get_basic typ = match (Types.repr typ).Types.tdesc with
246
    | Types.Tbasic Types.Basic.Tint -> Types.Basic.Tint
247
    | Types.Tbasic Types.Basic.Treal -> Types.Basic.Treal
248
    | Types.Tbasic Types.Basic.Tbool -> Types.Basic.Tbool
249
    | _ -> assert false (*TODO*)
250
  in
251
  get_basic typ1 = get_basic typ2
252

  
253

  
234 254
(** Print the type of a variable.
235 255
   @param fmt the formater to print on
236 256
   @param id the variable
......
438 458
let pp_clear_prototype m fmt =
439 459
  pp_base_prototype InOut m.mstatic [] fmt pp_clear_procedure_name
440 460

  
461
(** Print a one line comment with the final new line character to avoid
462
      commenting anything else.
463
   @param fmt the formater to print on
464
   @param s the comment without newline character
465
**)
466
let pp_oneline_comment fmt s =
467
  assert (not (String.contains s '\n'));
468
  fprintf fmt "-- %s@," s
441 469

  
442 470
(* Functions which computes the substitution for polymorphic type *)
443 471
(** Find a submachine step call in a list of instructions.
......
487 515
    begin
488 516
      (* We check that the type corresponding to type_poly in the subsitution
489 517
         match typ *)
490
      assert(check_type_equal (List.assoc type_poly.tid substituion) typ);
518
      (try
519
        assert(check_type_equal (List.assoc type_poly.tid substituion) typ)
520
      with
521
        Not_found -> assert false);
491 522
      (* We return the original substituion, it is already correct *)
492 523
      substituion
493 524
    end
......
556 587
       polymorphic type of the node *)
557 588
  let polymorphic_types = find_all_polymorphic_type submachine in
558 589
  assert (List.length polymorphic_types = List.length substitution);
559
  assert (List.for_all (function x->List.mem_assoc x substitution) polymorphic_types);
590
  (try
591
    assert (List.for_all (fun x -> List.mem_assoc x substitution) polymorphic_types)
592
  with
593
    Not_found -> assert false);
560 594
  substitution
561 595

  
562 596

  

Also available in: Unified diff