Project

General

Profile

Revision 01d48bb0 src/typing.ml

View differences:

src/typing.ml
111 111
  | Tydec_struct fl -> Type_predef.type_struct (List.map (fun (f, ty) -> (f, type_coretype type_dim ty)) fl)
112 112
  | Tydec_array (d, ty) ->
113 113
    begin
114
      let d = Dimension.copy (ref []) d in
114 115
      type_dim d;
115 116
      Type_predef.type_array d (type_coretype type_dim ty)
116 117
    end
......
311 312
  then raise (Error (loc, Not_a_constant))
312 313

  
313 314
let rec type_add_const env const arg targ =
315
(*Format.eprintf "Typing.type_add_const %a %a@." Printers.pp_expr arg Types.print_ty targ;*)
314 316
  if const
315 317
  then let d =
316 318
	 if is_dimension_type targ
......
357 359

  
358 360
(* type a call with possible dependent types. [targs] is here a list of (argument, type) pairs. *)
359 361
and type_dependent_call env in_main loc const f targs =
362
(*Format.eprintf "Typing.type_dependent_call %s@." f;*)
360 363
  let tins, touts = new_var (), new_var () in
361 364
  let tfun = Type_predef.type_arrow tins touts in
362 365
  type_subtyping_arg env in_main const (expr_of_ident f loc) tfun;
......
367 370
    begin
368 371
      List.iter2 (fun (a,t) ti ->
369 372
	let t' = type_add_const env (const || Types.get_static_value ti <> None) a t
370
	in try_unify ~sub:true ti t' a.expr_loc) targs tins;
371
      touts
373
	in try_unify ~sub:true ti t' a.expr_loc;
374
      ) targs tins;
375
(*Format.eprintf "Typing.type_dependent_call END@.";*)
376
      touts;
372 377
    end
373 378

  
374 379
(* type a simple call without dependent types 
......
506 511

  
507 512
(** [type_eq env eq] types equation [eq] in environment [env] *)
508 513
let type_eq env in_main undefined_vars eq =
514
(*Format.eprintf "Typing.type_eq %a@." Printers.pp_node_eq eq;*)
509 515
  (* Check undefined variables, type lhs *)
510 516
  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
511 517
  let ty_lhs = type_expr env in_main false expr_lhs in
512 518
  (* Check multiple variable definitions *)
513 519
  let define_var id uvars =
514
    try
515
      ignore(IMap.find id uvars);
516
      IMap.remove id uvars
517
    with Not_found ->
518
      raise (Error (eq.eq_loc, Already_defined id))
520
    if ISet.mem id uvars
521
    then ISet.remove id uvars
522
    else raise (Error (eq.eq_loc, Already_defined id))
519 523
  in
520 524
  (* check assignment of declared constant, assignment of clock *)
521 525
  let ty_lhs =
......
566 570
 | _                   -> ()
567 571

  
568 572
let type_var_decl vd_env env vdecl =
569
(*Format.eprintf "Typing.type_var_decl START %a@." Printers.pp_var vdecl;*)
573
(*Format.eprintf "Typing.type_var_decl START %a:%a@." Printers.pp_var vdecl Printers.print_dec_ty vdecl.var_dec_type.ty_dec_desc;*)
570 574
  check_type_declaration vdecl.var_loc vdecl.var_dec_type.ty_dec_desc;
571 575
  let eval_const id = Types.get_static_value (Env.lookup_value env id) in
572 576
  let type_dim d =
573 577
    begin
574 578
      type_subtyping_arg (env, vd_env) false true (expr_of_dimension d) Type_predef.type_int;
579

  
575 580
      Dimension.eval Basic_library.eval_env eval_const d;
576 581
    end in
577 582
  let ty = type_coretype type_dim vdecl.var_dec_type.ty_dec_desc in
578
  let ty_status =
583

  
584
  let ty_static =
579 585
    if vdecl.var_dec_const
580
    then Type_predef.type_static (Dimension.mkdim_var ()) ty
586
    then  Type_predef.type_static (Dimension.mkdim_var ()) ty
581 587
    else ty in
582
  let new_env = Env.add_value env vdecl.var_id ty_status in
588
  (match vdecl.var_dec_value with
589
  | None   -> ()
590
  | Some v -> type_subtyping_arg (env, vd_env) false ~sub:false true v ty_static);
591
  try_unify ty_static vdecl.var_type vdecl.var_loc;
592
  let new_env = Env.add_value env vdecl.var_id ty_static in
583 593
  type_coreclock (new_env,vd_env) vdecl.var_dec_clock vdecl.var_id vdecl.var_loc;
584
  vdecl.var_type <- ty_status;
585
(*Format.eprintf "END@.";*)
594
(*Format.eprintf "END %a@." Types.print_ty ty_static;*)
586 595
  new_env
587 596

  
588 597
let type_var_decl_list vd_env env l =
......
614 623
  let new_env = Env.overwrite env delta_env in
615 624
  let undefined_vars_init =
616 625
    List.fold_left
617
      (fun uvs v -> IMap.add v.var_id () uvs)
618
      IMap.empty vd_env_ol in
626
      (fun uvs v -> ISet.add v.var_id uvs)
627
      ISet.empty vd_env_ol in
619 628
  let undefined_vars =
620 629
    List.fold_left (type_eq (new_env, vd_env) is_main) undefined_vars_init (get_node_eqs nd)
621 630
  in
......
626 635
  )  nd.node_asserts;
627 636
  
628 637
  (* check that table is empty *)
629
  if (not (IMap.is_empty undefined_vars)) then
638
  let local_consts = List.fold_left (fun res vdecl -> if vdecl.var_dec_const then ISet.add vdecl.var_id res else res) ISet.empty nd.node_locals in
639
  let undefined_vars = ISet.diff undefined_vars local_consts in
640
  if (not (ISet.is_empty undefined_vars)) then
630 641
    raise (Error (loc, Undefined_var undefined_vars));
631 642
  let ty_ins = type_of_vlist nd.node_inputs in
632 643
  let ty_outs = type_of_vlist nd.node_outputs in
......
673 684
      try
674 685
	type_node env nd decl.top_decl_loc
675 686
      with Error (loc, err) as exc -> (
676
	if !Options.global_inline then
687
	(*if !Options.global_inline then
677 688
	  Format.eprintf "Type error: failing node@.%a@.@?"
678 689
	    Printers.pp_node nd
679
	;
690
	;*)
680 691
	raise exc)
681 692
  )
682 693
  | ImportedNode nd ->

Also available in: Unified diff