Revision 01d48bb0 src/typing.ml
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