Project

General

Profile

Revision 53206908 src/corelang.ml

View differences:

src/corelang.ml
1
(********************************************************************)
2 1
(*                                                                  *)
3 2
(*  The LustreC compiler toolset   /  The LustreC Development Team  *)
4 3
(*  Copyright 2012 -    --   ONERA - CNRS - INPT                    *)
......
55 54

  
56 55
let mkexpr loc d =
57 56
  { expr_tag = Utils.new_tag ();
57

  
58 58
    expr_desc = d;
59 59
    expr_type = Types.new_var ();
60 60
    expr_clock = Clocks.new_var true;
......
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
      "name %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.@."
......
811 811
      sym
812 812
  | Unknown_library sym ->
813 813
    fprintf fmt
814
      "impossible to load library %s.lusic.@.Please compile the corresponding interface or source file.@."
814
      "impossible to load library %s.lusic@.Please compile the corresponding interface or source file.@."
815 815
      sym
816 816
  | Wrong_number sym ->
817 817
    fprintf fmt
818
      "library %s.lusic has a different version number and may crash compiler.@.Please recompile the corresponding interface or source file.@."
818
      "library %s.lusic has a different version number and may crash the compiler.@.Please recompile the corresponding interface or source file.@."
819 819
      sym
820 820

  
821 821
(* filling node table with internal functions *)
......
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