Project

General

Profile

« Previous | Next » 

Revision f2c916b4

Added by Guillaume DAVY almost 3 years ago

Ada: Correct some errors on the type checking due to polymorphic type.

View differences:

src/backends/Ada/ada_backend_ads.ml
31 31
  let search_instr instruction = 
32 32
    match instruction.instr_desc with
33 33
      | MStep (il, i, vl) when String.equal i ident -> [
34
        (List.map (function x-> x.var_type) il,
35
           List.map (function x-> x.value_type) vl)]
34
        (List.map (function x-> x.value_type) vl,
35
            List.map (function x-> x.var_type) il)]
36 36
      | MBranch (_, l) -> List.flatten
37 37
          (List.map (function x, y -> find_submachine_step_call ident y) l)
38 38
      | _ -> []
......
44 44
   @param t2 an other type
45 45
   @param return true if the two types are Tbasic or Tunivar and equal
46 46
**)
47
let check_type_equal (t1:Types.type_expr) (t2:Types.type_expr) =
47
let rec check_type_equal (t1:Types.type_expr) (t2:Types.type_expr) =
48 48
  match (Types.repr t1).Types.tdesc, (Types.repr t2).Types.tdesc with
49 49
    | Types.Tbasic x, Types.Tbasic y -> x = y
50 50
    | Types.Tunivar,  Types.Tunivar  -> t1.tid = t2.tid
51
    | _ -> assert false (* TODO *)
51
    | Types.Ttuple l, _ -> assert (List.length l = 1); check_type_equal (List.hd l) t2
52
    | _, Types.Ttuple l -> assert (List.length l = 1); check_type_equal t1 (List.hd l)
53
    | Types.Tstatic (_, t), _ -> check_type_equal t t2
54
    | _, Types.Tstatic (_, t) -> check_type_equal t1 t
55
    | _ -> eprintf "ERROR: %a | %a" pp_type t1 pp_type t2; assert false (* TODO *)
52 56

  
53 57
(** Extend a substitution to unify the two given types. Only the
54 58
  first type can be polymorphic.
......
107 111
   @return the correspondance between polymorphic type id and their instantiation
108 112
**)
109 113
let get_substitution machine ident submachine =
114
  eprintf "%s %s %s@." machine.mname.node_id ident submachine.mname.node_id;
110 115
  (* extract the calls to submachines from the machine *)
111 116
  let calls = find_submachine_step_call ident machine.mstep.step_instrs in
112 117
  (* extract the first call  *)
......
126 131
      and the call *)
127 132
  assert (List.length machine_types = List.length call_types);
128 133
  (* Unify the two lists of types *)
129
  let substituion = List.fold_left unification [] (List.combine machine_types call_types) in
134
  let substitution = List.fold_left unification [] (List.combine machine_types call_types) in
130 135
  (* Assume that our substitution match all the possible
131 136
       polymorphic type of the node *)
132 137
  let polymorphic_types = find_all_polymorphic_type submachine in
133
  assert (List.length polymorphic_types = List.length substituion);
134
  assert (List.for_all (function x->List.mem_assoc x substituion) polymorphic_types);
135
  substituion
138
  assert (List.length polymorphic_types = List.length substitution);
139
  assert (List.for_all (function x->List.mem_assoc x substitution) polymorphic_types);
140
  substitution
136 141

  
137 142
(** Print the declaration of a state element of a subinstance of a machine.
138 143
   @param machine the machine
src/backends/Ada/ada_backend_common.ml
182 182
    | Types.Tbasic Types.Basic.Tint  -> pp_integer_type fmt
183 183
    | Types.Tbasic Types.Basic.Treal -> pp_float_type fmt
184 184
    | Types.Tbasic Types.Basic.Tbool -> pp_boolean_type fmt
185
    | Types.Tunivar                  -> pp_polymorphic_type fmt typ.tid
185
    | Types.Tunivar _                -> pp_polymorphic_type fmt typ.tid
186
    | Types.Tconst _                 -> eprintf "Tconst@."; assert false (*TODO*)
187
    | Types.Tclock _                 -> eprintf "Tclock@."; assert false (*TODO*)
188
    | Types.Tarrow _                 -> eprintf "Tarrow@."; assert false (*TODO*)
189
    | Types.Ttuple l                 -> eprintf "Ttuple %a @." (Utils.fprintf_list ~sep:" " Types.print_ty) l; assert false (*TODO*)
190
    | Types.Tenum _                  -> eprintf "Tenum@.";  assert false (*TODO*)
191
    | Types.Tstruct _                -> eprintf "Tstruct@.";assert false (*TODO*)
192
    | Types.Tarray _                 -> eprintf "Tarray@."; assert false (*TODO*)
193
    | Types.Tstatic _                -> eprintf "Tstatic@.";assert false (*TODO*)
194
    | Types.Tlink _                  -> eprintf "Tlink@.";  assert false (*TODO*)
195
    | Types.Tvar _                   -> eprintf "Tvar@.";   assert false (*TODO*)
186 196
    | _ -> eprintf "Type error : %a@." Types.print_ty typ; assert false (*TODO*)
187 197
  )
188 198

  

Also available in: Unified diff