Project

General

Profile

Revision b1655a21 src/corelang.ml

View differences:

src/corelang.ml
193 193
  let typ_def = Hashtbl.find type_table typ in
194 194
  if is_user_type typ_def then typ else typ_def
195 195

  
196
let rec coretype_equal ty1 ty2 =
197
  let res = 
198
  match ty1, ty2 with
199
  | Tydec_any       , _
200
  | _               , Tydec_any        -> assert false
201
  | Tydec_const _   , Tydec_const _    -> get_repr_type ty1 = get_repr_type ty2
202
  | Tydec_const _   , _                -> let ty1' = Hashtbl.find type_table ty1
203
					  in (not (is_user_type ty1')) && coretype_equal ty1' ty2
204
  | _               , Tydec_const _    -> coretype_equal ty2 ty1
205
  | Tydec_int       , Tydec_int
206
  | Tydec_real      , Tydec_real
207
  | Tydec_float     , Tydec_float
208
  | Tydec_bool      , Tydec_bool       -> true
209
  | Tydec_clock ty1 , Tydec_clock ty2  -> coretype_equal ty1 ty2
210
  | Tydec_enum tl1  , Tydec_enum tl2   -> List.sort compare tl1 = List.sort compare tl2
211
  | Tydec_struct fl1, Tydec_struct fl2 ->
212
       List.length fl1 = List.length fl2
213
    && List.for_all2 (fun (f1, t1) (f2, t2) -> f1 = f2 && coretype_equal t1 t2)
214
      (List.sort (fun (f1,_) (f2,_) -> compare f1 f2) fl1)
215
      (List.sort (fun (f1,_) (f2,_) -> compare f1 f2) fl2)
216
  | _                                  -> false
217
  in ((*Format.eprint "coretype_equal %a %a = %B@." Printers.pp_var_type_dec_desc ty1 Printers.pp_var_type_dec_desc ty2 res;*) res)
218

  
196 219
let tag_true = "true"
197 220
let tag_false = "false"
198 221

  
......
380 403
    fun nodes decl ->
381 404
      match decl.top_decl_desc with
382 405
	| Node nd -> nd::nodes
383
	| Consts _ | ImportedNode _ | Open _ -> nodes  
406
	| Consts _ | ImportedNode _ | Open _ | Type _ -> nodes  
384 407
  ) [] prog
385 408

  
386 409
let get_consts prog = 
......
388 411
    fun consts decl ->
389 412
      match decl.top_decl_desc with
390 413
	| Consts clist -> clist@consts
391
	| Node _ | ImportedNode _ | Open _ -> consts  
414
	| Node _ | ImportedNode _ | Open _ | Type _ -> consts  
392 415
  ) [] prog
393 416

  
394

  
417
let get_types prog = 
418
  List.fold_left (
419
    fun types decl ->
420
      match decl.top_decl_desc with
421
	| Type typ -> typ::types
422
	| Node _ | ImportedNode _ | Open _ | Consts _ -> types  
423
  ) [] prog
395 424

  
396 425
(************************************************************************)
397 426
(*        Renaming                                                      *)
......
543 572
      | Consts c -> 
544 573
	{ top with top_decl_desc = Consts (List.map (rename_const f_const) c) }
545 574
      | ImportedNode _
546
      | Open _ -> top)
575
      | Open _
576
      | Type _ -> top)
547 577
      ::accu
548 578
) [] prog
549 579
  )
......
561 591
    fprintf fmt "%s: " ind.nodei_id;
562 592
    Utils.reset_names ();
563 593
    fprintf fmt "%a@ " Types.print_ty ind.nodei_type
564
  | Consts _ | Open _ -> ()
594
  | Consts _ | Open _ | Type _ -> ()
565 595

  
566 596
let pp_prog_type fmt tdecl_list =
567 597
  Utils.fprintf_list ~sep:"" pp_decl_type fmt tdecl_list
......
576 606
    fprintf fmt "%s: " ind.nodei_id;
577 607
    Utils.reset_names ();
578 608
    fprintf fmt "%a@ " Clocks.print_ck ind.nodei_clock
579
  | Consts _ | Open _ -> ()
609
  | Consts _ | Open _ | Type _ -> ()
580 610

  
581 611
let pp_prog_clock fmt prog =
582 612
  Utils.fprintf_list ~sep:"" pp_decl_clock fmt prog

Also available in: Unified diff