Revision 3b2bd83d
Added by Teme Kahsai about 8 years ago
src/corelang.ml | ||
---|---|---|
245 | 245 |
|
246 | 246 |
let top_int_type = mktop (TypeDef {tydef_id = "int"; tydef_desc = Tydec_int}) |
247 | 247 |
let top_bool_type = mktop (TypeDef {tydef_id = "bool"; tydef_desc = Tydec_bool}) |
248 |
let top_float_type = mktop (TypeDef {tydef_id = "float"; tydef_desc = Tydec_float})
|
|
248 |
(* let top_float_type = mktop (TypeDef {tydef_id = "float"; tydef_desc = Tydec_float}) *)
|
|
249 | 249 |
let top_real_type = mktop (TypeDef {tydef_id = "real"; tydef_desc = Tydec_real}) |
250 | 250 |
|
251 | 251 |
let type_table = |
252 | 252 |
Utils.create_hashtable 20 [ |
253 | 253 |
Tydec_int , top_int_type; |
254 | 254 |
Tydec_bool , top_bool_type; |
255 |
Tydec_float, top_float_type;
|
|
255 |
(* Tydec_float, top_float_type; *)
|
|
256 | 256 |
Tydec_real , top_real_type |
257 | 257 |
] |
258 | 258 |
|
... | ... | |
270 | 270 |
let rec is_user_type typ = |
271 | 271 |
match typ with |
272 | 272 |
| Tydec_int | Tydec_bool | Tydec_real |
273 |
| Tydec_float | Tydec_any | Tydec_const _ -> false
|
|
273 |
(* | Tydec_float *) | Tydec_any | Tydec_const _ -> false
|
|
274 | 274 |
| Tydec_clock typ' -> is_user_type typ' |
275 | 275 |
| _ -> true |
276 | 276 |
|
... | ... | |
289 | 289 |
| _ , Tydec_const _ -> coretype_equal ty2 ty1 |
290 | 290 |
| Tydec_int , Tydec_int |
291 | 291 |
| Tydec_real , Tydec_real |
292 |
| Tydec_float , Tydec_float
|
|
292 |
(* | Tydec_float , Tydec_float *)
|
|
293 | 293 |
| Tydec_bool , Tydec_bool -> true |
294 | 294 |
| Tydec_clock ty1 , Tydec_clock ty2 -> coretype_equal ty1 ty2 |
295 | 295 |
| Tydec_array (d1,ty1), Tydec_array (d2, ty2) -> Dimension.is_eq_dimension d1 d2 && coretype_equal ty1 ty2 |
... | ... | |
461 | 461 |
match expr.expr_desc with |
462 | 462 |
| Expr_const c -> dimension_of_const expr.expr_loc c |
463 | 463 |
| Expr_ident id -> mkdim_ident expr.expr_loc id |
464 |
| Expr_appl (f, args, None) when Basic_library.is_internal_fun f ->
|
|
464 |
| Expr_appl (f, args, None) when Basic_library.is_expr_internal_fun expr ->
|
|
465 | 465 |
let k = Types.get_static_value (Env.lookup_value Basic_library.type_env f) in |
466 | 466 |
if k = None then raise InvalidDimension; |
467 | 467 |
mkdim_appl expr.expr_loc f (List.map dimension_of_expr (expr_list_of_expr args)) |
... | ... | |
501 | 501 |
mk_new_name used id |
502 | 502 |
|
503 | 503 |
let get_var id var_list = |
504 |
List.find (fun v -> v.var_id = id) var_list
|
|
504 |
List.find (fun v -> v.var_id = id) var_list |
|
505 | 505 |
|
506 | 506 |
let get_node_var id node = |
507 | 507 |
get_var id (get_node_vars node) |
... | ... | |
579 | 579 |
nodei_stateless = nd.node_dec_stateless; |
580 | 580 |
nodei_spec = nd.node_spec; |
581 | 581 |
nodei_prototype = None; |
582 |
nodei_in_lib = None;
|
|
582 |
nodei_in_lib = [];
|
|
583 | 583 |
} |
584 | 584 |
|
585 | 585 |
(************************************************************************) |
... | ... | |
624 | 624 |
let eq_replace_rhs_var pvar fvar eq = |
625 | 625 |
let pvar l = List.exists pvar l in |
626 | 626 |
let rec replace lhs rhs = |
627 |
{ rhs with expr_desc = replace_desc lhs rhs.expr_desc } |
|
628 |
and replace_desc lhs rhs_desc = |
|
627 |
{ rhs with expr_desc = |
|
629 | 628 |
match lhs with |
630 | 629 |
| [] -> assert false |
631 |
| [_] -> if pvar lhs then expr_desc_replace_var fvar rhs_desc else rhs_desc
|
|
630 |
| [_] -> if pvar lhs then expr_desc_replace_var fvar rhs.expr_desc else rhs.expr_desc
|
|
632 | 631 |
| _ -> |
633 |
(match rhs_desc with |
|
632 |
(match rhs.expr_desc with
|
|
634 | 633 |
| Expr_tuple tl -> |
635 | 634 |
Expr_tuple (List.map2 (fun v e -> replace [v] e) lhs tl) |
636 |
| Expr_appl (f, arg, None) when Basic_library.is_internal_fun f ->
|
|
635 |
| Expr_appl (f, arg, None) when Basic_library.is_expr_internal_fun rhs ->
|
|
637 | 636 |
let args = expr_list_of_expr arg in |
638 | 637 |
Expr_appl (f, expr_of_expr_list arg.expr_loc (List.map (replace lhs) args), None) |
639 | 638 |
| Expr_array _ |
... | ... | |
643 | 642 |
| Expr_ident _ |
644 | 643 |
| Expr_appl _ -> |
645 | 644 |
if pvar lhs |
646 |
then expr_desc_replace_var fvar rhs_desc |
|
647 |
else rhs_desc |
|
645 |
then expr_desc_replace_var fvar rhs.expr_desc
|
|
646 |
else rhs.expr_desc
|
|
648 | 647 |
| Expr_ite (c, t, e) -> Expr_ite (replace lhs c, replace lhs t, replace lhs e) |
649 | 648 |
| Expr_arrow (e1, e2) -> Expr_arrow (replace lhs e1, replace lhs e2) |
650 | 649 |
| Expr_fby (e1, e2) -> Expr_fby (replace lhs e1, replace lhs e2) |
... | ... | |
654 | 653 |
| Expr_merge (i, hl) -> let i' = if pvar lhs then fvar i else i |
655 | 654 |
in Expr_merge (i', List.map (fun (t, h) -> (t, replace lhs h)) hl) |
656 | 655 |
) |
656 |
} |
|
657 | 657 |
in { eq with eq_rhs = replace eq.eq_lhs eq.eq_rhs } |
658 | 658 |
|
659 | 659 |
|
... | ... | |
792 | 792 |
Utils.fprintf_list ~sep:"" pp_decl_clock fmt prog |
793 | 793 |
|
794 | 794 |
let pp_error fmt = function |
795 |
| Main_not_found ->
|
|
796 |
fprintf fmt "cannot compile node %s: could not find the node definition.@."
|
|
797 |
!Options.main_node
|
|
795 |
Main_not_found ->
|
|
796 |
fprintf fmt "Could not find the definition of main node %s.@."
|
|
797 |
!Global.main_node
|
|
798 | 798 |
| Main_wrong_kind -> |
799 | 799 |
fprintf fmt |
800 |
"name %s does not correspond to a (non-imported) node definition.@."
|
|
801 |
!Options.main_node
|
|
800 |
"Node %s does not correspond to a valid main node definition.@."
|
|
801 |
!Global.main_node
|
|
802 | 802 |
| No_main_specified -> |
803 |
fprintf fmt "no main node specified.@."
|
|
803 |
fprintf fmt "No main node specified (use -node option)@."
|
|
804 | 804 |
| Unbound_symbol sym -> |
805 | 805 |
fprintf fmt |
806 | 806 |
"%s is undefined.@." |
... | ... | |
844 | 844 |
nodei_stateless = Types.get_static_value ty <> None; |
845 | 845 |
nodei_spec = spec; |
846 | 846 |
nodei_prototype = None; |
847 |
nodei_in_lib = None;
|
|
847 |
nodei_in_lib = [];
|
|
848 | 848 |
}) |
849 | 849 |
|
850 | 850 |
let add_internal_funs () = |
... | ... | |
927 | 927 |
|
928 | 928 |
*) |
929 | 929 |
let rec get_expr_calls nodes e = |
930 |
get_calls_expr_desc nodes e.expr_desc |
|
931 |
and get_calls_expr_desc nodes expr_desc = |
|
932 | 930 |
let get_calls = get_expr_calls nodes in |
933 |
match expr_desc with |
|
931 |
match e.expr_desc with
|
|
934 | 932 |
| Expr_const _ |
935 | 933 |
| Expr_ident _ -> Utils.ISet.empty |
936 | 934 |
| Expr_tuple el |
... | ... | |
944 | 942 |
| Expr_fby (e1, e2) -> Utils.ISet.union (get_calls e1) (get_calls e2) |
945 | 943 |
| Expr_merge (_, hl) -> List.fold_left (fun accu (_, h) -> Utils.ISet.union accu (get_calls h)) Utils.ISet.empty hl |
946 | 944 |
| Expr_appl (i, e', i') -> |
947 |
if Basic_library.is_internal_fun i then
|
|
945 |
if Basic_library.is_expr_internal_fun e then
|
|
948 | 946 |
(get_calls e') |
949 | 947 |
else |
950 | 948 |
let calls = Utils.ISet.add i (get_calls e') in |
Also available in: Unified diff
updating to onera version 30f766a:2016-12-04